PC-Dmis to Excel, through PC-Dmis Script

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

Rploughe over 9 years ago

Drop-in Script Part2

 
'Open Excel And Base form
'Display Excel, While hiding Pc-Dmis
xlApp.Application.Visible = True
App.Visible = False
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlsheets = xlworkbook.worksheets
'by default first sheet is "Sheet1" In a workbook.  If you save a default template_
'Then you need To adjust the following Set xlsheet assignment To match
Set xlSheet = xlWorkbook.Worksheets("Sheet1")
Set fncSheet = xlApp.WorkSheetFunction
'Pc-Dmis Variable Call-In
Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
Set Partnu = Part.GetVariableValue("PARTNUMBER")
Set Partna = Part.GetVariableValue("PARTNAME")
Set Printrevver = Part.GetVariableValue("PRINTREV1")
Set Samp = Part.GetVariableValue("SAMP")
Dim sh As Worksheet, flg As Boolean
Dim Nomi, Plustol, Minustol, Meas, WidthSet
'Search the Open workbook For a sheet Name
For Each sh In xlworkbook.worksheets
    If sh.Name = SheetPath Then flg = True : Exit For
Next
'If sheet is Not found, add one
If flg = False Then
    xlsheets.Add.Name = SheetPath
End If
'Asssign sheet Name To be populated
Set xlSheet = xlWorkbook.Worksheets(SheetPath)
'If the file did Not exist, start execution To populate main data
If objFSO.FileExists(ResFileExists) = False Or xlsheet.cells(1,1).Value = "" Then
    RCount = 7
    CCount = 3
    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 :"
    WidthSet = xlSheet.Range("A4").Columns.AutoFit()

    xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
    WidthSet =     xlSheet.Cells(RCount - 1, 2).Columns.AutoFit()
    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 = "--"
    i = 0
    For Each Cmd In Cmds
         i = i + 1
         App.StatusBar = "Cycling through commands. Current command: " & i
         '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 = fncsheet.Round(Cmd.GetText(LINE2_DEV, 1),6)
                   If xlsheet.Cells(RCount+5,CCount).value > xlsheet.cells(Rcount+2,Ccount).Value Then
                        xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                   End If
                   WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
                   WidthSet = xlSheet.Cells(RCount,CCount).Columns.AutoFit()
              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
                        WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
              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 = ""
                        If Dcmd.Nominal < 0 Then
                             Set Nomi = Abs(DCmd.Nominal)
                             Set PlusTol =  fncsheet.Sum(Nomi,Abs((DCmd.Plus)))
                             Set MinusTol = fncsheet.Sum(Nomi,-Abs((DCmd.Minus)))
                        Else
                             Set Nomi = DCmd.Nominal
                             Set PlusTol =  fncsheet.Sum(Nomi,(DCmd.Plus))
                             Set MinusTol = fncsheet.Sum(Nomi,-(DCmd.Minus))
                        End If
                        xlSheet.Cells(RCount+1,CCount).Value = Nomi
                        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
                             Set Meas = Abs(fncsheet.Round(DCmd.Measured,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If Meas > PlusTol Or _
                             Meas < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        Else
                             Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If Meas > PlusTol Or _
                             Meas < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        End If 'DCmd.AxisLetter <> "TP" 
                        'Add For Profile dimensions
                        If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                             Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If xlsheet.Cells(RCount+5,CCount).value > PlusTol Or _
                             xlsheet.Cells(RCount+5,CCount).value < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        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

Reply

Rploughe over 9 years ago

Drop-in Script Part2

 
'Open Excel And Base form
'Display Excel, While hiding Pc-Dmis
xlApp.Application.Visible = True
App.Visible = False
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlsheets = xlworkbook.worksheets
'by default first sheet is "Sheet1" In a workbook.  If you save a default template_
'Then you need To adjust the following Set xlsheet assignment To match
Set xlSheet = xlWorkbook.Worksheets("Sheet1")
Set fncSheet = xlApp.WorkSheetFunction
'Pc-Dmis Variable Call-In
Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
Set Partnu = Part.GetVariableValue("PARTNUMBER")
Set Partna = Part.GetVariableValue("PARTNAME")
Set Printrevver = Part.GetVariableValue("PRINTREV1")
Set Samp = Part.GetVariableValue("SAMP")
Dim sh As Worksheet, flg As Boolean
Dim Nomi, Plustol, Minustol, Meas, WidthSet
'Search the Open workbook For a sheet Name
For Each sh In xlworkbook.worksheets
    If sh.Name = SheetPath Then flg = True : Exit For
Next
'If sheet is Not found, add one
If flg = False Then
    xlsheets.Add.Name = SheetPath
End If
'Asssign sheet Name To be populated
Set xlSheet = xlWorkbook.Worksheets(SheetPath)
'If the file did Not exist, start execution To populate main data
If objFSO.FileExists(ResFileExists) = False Or xlsheet.cells(1,1).Value = "" Then
    RCount = 7
    CCount = 3
    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 :"
    WidthSet = xlSheet.Range("A4").Columns.AutoFit()

    xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
    WidthSet =     xlSheet.Cells(RCount - 1, 2).Columns.AutoFit()
    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 = "--"
    i = 0
    For Each Cmd In Cmds
         i = i + 1
         App.StatusBar = "Cycling through commands. Current command: " & i
         '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 = fncsheet.Round(Cmd.GetText(LINE2_DEV, 1),6)
                   If xlsheet.Cells(RCount+5,CCount).value > xlsheet.cells(Rcount+2,Ccount).Value Then
                        xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                   End If
                   WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
                   WidthSet = xlSheet.Cells(RCount,CCount).Columns.AutoFit()
              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
                        WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
              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 = ""
                        If Dcmd.Nominal < 0 Then
                             Set Nomi = Abs(DCmd.Nominal)
                             Set PlusTol =  fncsheet.Sum(Nomi,Abs((DCmd.Plus)))
                             Set MinusTol = fncsheet.Sum(Nomi,-Abs((DCmd.Minus)))
                        Else
                             Set Nomi = DCmd.Nominal
                             Set PlusTol =  fncsheet.Sum(Nomi,(DCmd.Plus))
                             Set MinusTol = fncsheet.Sum(Nomi,-(DCmd.Minus))
                        End If
                        xlSheet.Cells(RCount+1,CCount).Value = Nomi
                        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
                             Set Meas = Abs(fncsheet.Round(DCmd.Measured,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If Meas > PlusTol Or _
                             Meas < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        Else
                             Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If Meas > PlusTol Or _
                             Meas < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        End If 'DCmd.AxisLetter <> "TP" 
                        'Add For Profile dimensions
                        If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                             Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                             xlSheet.Cells(RCount+5, CCount).Value = Meas
                             If xlsheet.Cells(RCount+5,CCount).value > PlusTol Or _
                             xlsheet.Cells(RCount+5,CCount).value < MinusTol Then
                                  xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                             End If
                        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

Children

No Data