hexagon logo
Register Sign in
  • Replies 22 replies
  • Subscribers 34 subscribers
  • Views 545 views
  • Users 0 members are here
Options
Related

PC-Dmis to Excel, through PC-Dmis Script

Rploughe
I know there is currently a VB project that runs in Excel during execution that will pull information into the workbook during execution. I decided to venture out and try some of my own approaches with a combination of data I found online here and there.

What I have is a script that can be executed in program, without too much setup and hassle, that will export data into an excel workbook like a print command would. I feel this script offers a little more versatility.

I will not claim ownership of this program. I just tweaked it to fit my needs. So far I have it running, and it works quite well.

I will answer what questions I can, but for the most part I wanted to post it to have as a reference.

It's a long program........
Parents 
  • 
        'Open Excel And Base form
        Set xlApp = CreateObject("Excel.Application")
        Set xlWorkbooks = xlapp.Workbooks
        Set xlWorkbook = xlWorkbooks.Open(TempFilename)
        Set xlSheet = xlWorkbook.Worksheets("#Main Page")
        Set xlsheets = xlworkbook.worksheets
        Set fncSheet = xlApp.WorkSheetFunction
        Dim Nomi, Plustol, Minustol
        Dim sh As Worksheet, flg As Boolean
        For Each sh In xlworkbook.worksheets
            If sh.Name = myProject Then flg = True : Exit For
        Next
        If flg = False Then
            xlsheets.Add.Name = myProject
        End If
        Set xlSheet = xlWorkbook.Worksheets(myProject)
If objFSO.FileExists(ResFileExists) = False Then
    RCount = 7
    CCount = 3
    Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
    Set Partnu = Part.GetVariableValue("PARTNUM")
    Set Partna = Part.GetVariableValue("PARTNAM")
    Set Printrevver = Part.GetVariableValue("PRINTREV1")
    xlSheet.Range("B1").Value = CMMPrognam.StringValue
    xlSheet.Range("A1").Value = "Program Name :"
    xlSheet.Range("B2").Value = Partnu.StringValue
    xlSheet.Range("A2").Value = "Part # :"
    xlSheet.Range("B3").Value = Partna.StringValue
    xlSheet.Range("A3").Value = "Part Name :"
    xlSheet.Range("B4").Value = Printrevver.StringValue
    xlSheet.Range("A4").Value = "Print Information :"
    Set Samp = Part.GetVariableValue("SAMP")
    xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
    xlSheet.Cells(RCount + 5, 1).Value = "Sample # : "
    xlSheet.Cells(RCount + 5, 2).Value = Samp.StringValue
    xlSheet.Cells(RCount + 0, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 1).Value = "--"
    xlSheet.Cells(RCount + 2, 1).Value = "--"
    xlSheet.Cells(RCount + 3, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 2).Value = "Nominal"
    xlSheet.Cells(RCount + 2, 2).Value = "USL"
    xlSheet.Cells(RCount + 3, 2).Value = "LSL"
    xlSheet.Cells(RCount + 4, 1).Value = "--"
    xlSheet.Cells(RCount + 4, 2).Value = "--"
For Each Cmd In Cmds
         'Do GDT
         If Cmd.Type = 184 Then ' FCF
              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                   xlSheet.Cells(RCount-1,CCount).Value = Cmd.GetText (ID, 0) 
                   xlSheet.Cells(RCount,CCount).Value =  Cmd.GetText(GDT_SYMBOL, 0)
                   xlSheet.Cells(RCount+1,CCount).Value = "0"
                   xlSheet.Cells(RCount+2,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                   xlSheet.Cells(RCount+3,CCount).Value = "0"
                   xlSheet.Cells(RCount+4, CCount).Value = "--"
                   xlSheet.Cells(RCount+5, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
              CCount = CCount + 1
         End If
         'Do Dimensions
         If Cmd.IsDimension Then
              If Cmd.Type = DIMENSION_START_LOCATION Or _
                   Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                      xlSheet.Cells(RCount - 1, CCount).Value = DcmdID.Id
              End If
              If Cmd.Type <> DIMENSION_START_LOCATION And _
                   Cmd.Type <> DIMENSION_END_LOCATION And _
                   Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                   Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                   Cmd.Type <> DATDEF_COMMAND Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                   If CheckDim <> "" Then
                            ReportDim = CheckDim
                   End If
                        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                             If DCmd.ID = "" Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.AxisLetter
                             Else
                                  xlSheet.Cells(RCount - 1, CCount).Value = Dcmd.Id
                                  xlSheet.Cells(RCount, CCount).Value = "M"
                             End If 'DCmd.ID = ""
                             xlSheet.Cells(RCount+1,CCount).Value = DCmd.Nominal
                             Set PlusTol =  fncsheet.Sum(DCmd.Nominal,(DCmd.Plus))
                             Set MinusTol = fncsheet.Sum(DCmd.Nominal,-(DCmd.Minus))
                             xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
                             xlSheet.Cells(RCount + 3, CCount).Value = MinusTol
                             xlSheet.Cells(RCount+4, CCount).Value = "--"
                             'Measured Or Deviation With check For True Position
                             If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Measured
                             Else
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                             End If 'DCmd.AxisLetter <> "TP" 
                             'Add For Profile dimensions
                             If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                             End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                        End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                        CCount = CCount + 1
              End If
         End If
Next Cmd
Else 'If ResFileExists = False Then
     If objFSO.FileExists(ResFileExists) = True Then 
    RCount = 11
    Found = 0
    Do Until Found = 1
    RCount = RCount + 1
    If xlSheet.Cells(RCount,1).Value = "" Then
    Found=Found+1
    End If
    Loop
    Samp = Part.GetVariableValue("SAMP")
    xlSheet.Cells(RCount, 1).Value = "Sample # :"
    xlSheet.Cells(RCount, 2).Value = Samp.StringValue
    'Fill In measured data
    CCount = 3
For Each Cmd In Cmds
         'Do GDT
         If Cmd.Type = 184 Then ' FCF
              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                   xlSheet.Cells(RCount, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
              CCount = CCount + 1
         End If
         'Do Dimensions
         If Cmd.IsDimension Then
              If Cmd.Type = DIMENSION_START_LOCATION Or _
                   Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
              End If
              If Cmd.Type <> DIMENSION_START_LOCATION And _
                   Cmd.Type <> DIMENSION_END_LOCATION And _
                   Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                   Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                   Cmd.Type <> DATDEF_COMMAND Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                   If CheckDim <> "" Then
                            ReportDim = CheckDim
                   End If
                        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                             'Measured Or Deviation With check For True Position
                             If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Measured
                             Else
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                             End If 'DCmd.AxisLetter <> "TP" 
                             'Add For Profile dimensions
                             If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                             End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                        End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                        CCount = CCount + 1
              End If
         End If
Next Cmd
        End If
End If 'If ResFileExists = False Then
Reply 
  • 
        'Open Excel And Base form
        Set xlApp = CreateObject("Excel.Application")
        Set xlWorkbooks = xlapp.Workbooks
        Set xlWorkbook = xlWorkbooks.Open(TempFilename)
        Set xlSheet = xlWorkbook.Worksheets("#Main Page")
        Set xlsheets = xlworkbook.worksheets
        Set fncSheet = xlApp.WorkSheetFunction
        Dim Nomi, Plustol, Minustol
        Dim sh As Worksheet, flg As Boolean
        For Each sh In xlworkbook.worksheets
            If sh.Name = myProject Then flg = True : Exit For
        Next
        If flg = False Then
            xlsheets.Add.Name = myProject
        End If
        Set xlSheet = xlWorkbook.Worksheets(myProject)
If objFSO.FileExists(ResFileExists) = False Then
    RCount = 7
    CCount = 3
    Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
    Set Partnu = Part.GetVariableValue("PARTNUM")
    Set Partna = Part.GetVariableValue("PARTNAM")
    Set Printrevver = Part.GetVariableValue("PRINTREV1")
    xlSheet.Range("B1").Value = CMMPrognam.StringValue
    xlSheet.Range("A1").Value = "Program Name :"
    xlSheet.Range("B2").Value = Partnu.StringValue
    xlSheet.Range("A2").Value = "Part # :"
    xlSheet.Range("B3").Value = Partna.StringValue
    xlSheet.Range("A3").Value = "Part Name :"
    xlSheet.Range("B4").Value = Printrevver.StringValue
    xlSheet.Range("A4").Value = "Print Information :"
    Set Samp = Part.GetVariableValue("SAMP")
    xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
    xlSheet.Cells(RCount + 5, 1).Value = "Sample # : "
    xlSheet.Cells(RCount + 5, 2).Value = Samp.StringValue
    xlSheet.Cells(RCount + 0, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 1).Value = "--"
    xlSheet.Cells(RCount + 2, 1).Value = "--"
    xlSheet.Cells(RCount + 3, 1).Value = "--"
    xlSheet.Cells(RCount + 1, 2).Value = "Nominal"
    xlSheet.Cells(RCount + 2, 2).Value = "USL"
    xlSheet.Cells(RCount + 3, 2).Value = "LSL"
    xlSheet.Cells(RCount + 4, 1).Value = "--"
    xlSheet.Cells(RCount + 4, 2).Value = "--"
For Each Cmd In Cmds
         'Do GDT
         If Cmd.Type = 184 Then ' FCF
              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                   xlSheet.Cells(RCount-1,CCount).Value = Cmd.GetText (ID, 0) 
                   xlSheet.Cells(RCount,CCount).Value =  Cmd.GetText(GDT_SYMBOL, 0)
                   xlSheet.Cells(RCount+1,CCount).Value = "0"
                   xlSheet.Cells(RCount+2,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                   xlSheet.Cells(RCount+3,CCount).Value = "0"
                   xlSheet.Cells(RCount+4, CCount).Value = "--"
                   xlSheet.Cells(RCount+5, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
              CCount = CCount + 1
         End If
         'Do Dimensions
         If Cmd.IsDimension Then
              If Cmd.Type = DIMENSION_START_LOCATION Or _
                   Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                      xlSheet.Cells(RCount - 1, CCount).Value = DcmdID.Id
              End If
              If Cmd.Type <> DIMENSION_START_LOCATION And _
                   Cmd.Type <> DIMENSION_END_LOCATION And _
                   Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                   Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                   Cmd.Type <> DATDEF_COMMAND Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                   If CheckDim <> "" Then
                            ReportDim = CheckDim
                   End If
                        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                             If DCmd.ID = "" Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.AxisLetter
                             Else
                                  xlSheet.Cells(RCount - 1, CCount).Value = Dcmd.Id
                                  xlSheet.Cells(RCount, CCount).Value = "M"
                             End If 'DCmd.ID = ""
                             xlSheet.Cells(RCount+1,CCount).Value = DCmd.Nominal
                             Set PlusTol =  fncsheet.Sum(DCmd.Nominal,(DCmd.Plus))
                             Set MinusTol = fncsheet.Sum(DCmd.Nominal,-(DCmd.Minus))
                             xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
                             xlSheet.Cells(RCount + 3, CCount).Value = MinusTol
                             xlSheet.Cells(RCount+4, CCount).Value = "--"
                             'Measured Or Deviation With check For True Position
                             If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Measured
                             Else
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                             End If 'DCmd.AxisLetter <> "TP" 
                             'Add For Profile dimensions
                             If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                             End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                        End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                        CCount = CCount + 1
              End If
         End If
Next Cmd
Else 'If ResFileExists = False Then
     If objFSO.FileExists(ResFileExists) = True Then 
    RCount = 11
    Found = 0
    Do Until Found = 1
    RCount = RCount + 1
    If xlSheet.Cells(RCount,1).Value = "" Then
    Found=Found+1
    End If
    Loop
    Samp = Part.GetVariableValue("SAMP")
    xlSheet.Cells(RCount, 1).Value = "Sample # :"
    xlSheet.Cells(RCount, 2).Value = Samp.StringValue
    'Fill In measured data
    CCount = 3
For Each Cmd In Cmds
         'Do GDT
         If Cmd.Type = 184 Then ' FCF
              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                   xlSheet.Cells(RCount, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
              CCount = CCount + 1
         End If
         'Do Dimensions
         If Cmd.IsDimension Then
              If Cmd.Type = DIMENSION_START_LOCATION Or _
                   Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                    Set DcmdID = Cmd.DimensionCommand
                      DimID = DcmdID.ID
                      ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
              End If
              If Cmd.Type <> DIMENSION_START_LOCATION And _
                   Cmd.Type <> DIMENSION_END_LOCATION And _
                   Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                   Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                   Cmd.Type <> DATDEF_COMMAND Then
                    Set DCmd = Cmd.DimensionCommand
                    CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                   If CheckDim <> "" Then
                            ReportDim = CheckDim
                   End If
                        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                             'Measured Or Deviation With check For True Position
                             If DCmd.AxisLetter <> "TP" Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Measured
                             Else
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                             End If 'DCmd.AxisLetter <> "TP" 
                             'Add For Profile dimensions
                             If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                  xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                             End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                        End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                        CCount = CCount + 1
              End If
         End If
Next Cmd
        End If
End If 'If ResFileExists = False Then
Children
No Data
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement