Script Help Needed - Export Xactmeasure dimensions

I have a program that reports several Xactmeasure line profiles. I have to put the max/min values of each profile into a spreadsheet. Right now I do that by hand. I'm looking for a way to automate the process using a script. I have a script that I use to extract nominal and measured values for points and am thinking I can modify it but I have no idea how to "find" the Xactmeasure profile dimensions in my program within the script. Any ideas?

Parents

N3WPV over 11 years ago

This was sent to me as a solution. Will be making a few modifications and trying out.

Sub Main'     Original CSV Ouput Script by Jay Hall of Hexagon Metrology
'      Modified by Josh Carpenter, Mike Grones, Andy Mears,  And Jay Hall of Hexagon Metrology     August 2011
'        Modifications: Captures all Xactmeasure data For multiple features, including sizes & summary reference axial deviations.
'                                Also names CSV file With part Name, serial number, And date-time stamp
' Notes:
'       Variable "SERNO" For Serial Number must be present In PC-DMIS part program
'        Exports CSV data To C:\YOUR_FOLDER_HERE\CSV Data Output\, change below On Line 36
'        PC-DMIS v2011 Release: when using Xactmeasure To dimension Position of multiple holes, make sure the required axis are of the Feature Set are checked.


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim Ccmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim str As String


Dim Int As Integer
Dim IntTest As String
Dim strType As String
Dim SumTest As String
Dim Int2 As Integer


Dim Headertype As Integer
HeaderType = 0




Dim Serial As Object
Set Serial = Part.GetVariableValue ("SERNO")


'Open file **** Change File Path if needed *****************************************************************************************************************************************************************


FileName = "C:\YOUR_FOLDER_HERE\" & Part.PartName & "_" & Serial.StringValue & "_"  & Month(Date) & Day(Date) & Year(Date) & "_"  & Hour(Time) & Minute(Time) & ".csv"
Open FileName For Output As #1
Print #1, "Part,Serial #,Date,Time"
Print #1, Part.PartName & "," & Serial.StringValue & "," & Month(Date) & Day(Date) & Year(Date) & ","  & Hour(Time) & Minute(Time)


'Sort Program*********************************************************************************************************************************************************************
For Each Cmd In Cmds
'...................................................... Process non-GD&T Dimensional Data ......................................................
If Cmd.Type <> 184 Then '#1
If Cmd.Type <> 1299 Then '#2
  If Cmd.IsDimension Then '#3
    If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
      Set DcmdID = Cmd.DimensionCommand
        Print #1, DcmdID.ID & ",,,,,,,,,"
    End If ' #4
    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 Then
      Set DCmd = Cmd.DimensionCommand
		'Every Dimension gets a header, just like PC-DMIS report
		Print #1, "Feature,Axis,Nominal,Plus Tol,Minus Tol,Measured,Deviation,Out Tol"
      If DCmd.ID = "" Then '#5
        str = "," & Format(DCmd.AxisLetter ,"0.0000") & "," & Format(DCmd.Nominal ,"0.0000") & "," & Format(DCmd.Plus ,"0.0000") & "," & Format(DCmd.Minus,"0.0000") & "," & Format(DCmd.Measured,"0.0000") & "," & Format(DCmd.Deviation,"0.0000") & "," & Format(DCmd.OutTol,"0.0000")
        Print #1, str
      Else
        Print #1, DCmd.ID & ",,,,,,,,,"
        str = "," & "M" & "," & Format(DCmd.Nominal ,"0.0000") & "," & Format(DCmd.Plus,"0.0000") & "," & Format(DCmd.Minus,"0.0000") & "," & Format(DCmd.Measured,"0.0000") & "," & Format(DCmd.Deviation,"0.0000") & "," & Format(DCmd.OutTol,"0.0000")
        Print #1, str
      End If '#5
    End If '#4
  End If '#3 Is dimension
End If '#2 Not Cmd.Type 1299
End If '#1Not Cmd.Type 184


'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _Process Xactmeasure GD&T _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
If Cmd.Type = 184 Then
  str = Cmd.GetText (ID, 0) 
  Print #1, str
strType = Cmd.GetText (GDT_SYMBOL, 0)


If strType = "POSITION" Then
	Print #1, "Feature,Axis,Nominal,Plus Tol,Minus Tol,Measured,Deviation,Out Tol"
  Int = 1 'Line1 Size Dimensions of Xactmeasure
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & "SIZE" & "," & Format(cdbl(Cmd.GetText (LINE1_NOMINAL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_PLUSTOL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_MINUSTOL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_MEAS, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_DEV, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
   Wend 'Line1
  Int = 1 'Line2 True Positions
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & strType & "," & "0.000" & "," & Format(cdbl(Cmd.GetText (LINE2_PLUSTOL, Int)) ,"0.0000") & "," & "0.000" & "," & Format(cdbl(Cmd.GetText (LINE2_MEAS, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_DEV, Int)),"0.000") & "," & Format(cdbl(Cmd.GetText (LINE2_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
   Wend' Line2
Int = 1 'Summary Axis Deviations For Reference
  IntTest = Cmd.GetText (SUMMARY_MEAS, Int)
   While IntTest <> ""
	str = Cmd.GetText (SUMMARY_FEAT, Int) & "," & Cmd.GetText (SUMMARY_AXIS, Int) & "," & Format(cdbl(Cmd.GetText (SUMMARY_NOMINAL, Int)) ,"0.0000") & ",,," & Format(cdbl(Cmd.GetText (SUMMARY_MEAS, Int)),"0.0000")& "," & Format(cdbl(Cmd.GetText (SUMMARY_DEV, Int)),"0.0000")
           Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (SUMMARY_MEAS, Int)
        Wend 'Summary
End If 'Position


If strType <> "POSITION" Then
'All Non-Position GD&T Get Min And Max instead of Meas And Dev
    Print #1, "Feature,Type,Nominal,Plus Tol,Minus Tol,Max,Min,Out Tol"
  Int = 1
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & strType & "," & "0.0000" & "," & Format(cdbl(Cmd.GetText (LINE2_PLUSTOL, Int)) ,"0.0000") & "," & "0.0000" & "," & Format(cdbl(Cmd.GetText (LINE2_MAX, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_MIN, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
    Wend
  End If ' is Not Position


End If ' is Cmd.Type 184 Xactmeasure GD&T


'~~~~~~~~~~ Process Report Comments ~~~~~~~~~~ 
      If Cmd.IsComment Then
          Set Ccmd = Cmd.CommentCommand
           If Ccmd.CommentType = 1 Then
              str = Ccmd.Comment & ",,,,,,,,,"
              Print #1, str
           End If
      End If 'Comments


Next Cmd




'Save And Cleanup*******************************************************************************************************************************************************************
Close #1


End Sub

Reply

N3WPV over 11 years ago

This was sent to me as a solution. Will be making a few modifications and trying out.

Sub Main'     Original CSV Ouput Script by Jay Hall of Hexagon Metrology
'      Modified by Josh Carpenter, Mike Grones, Andy Mears,  And Jay Hall of Hexagon Metrology     August 2011
'        Modifications: Captures all Xactmeasure data For multiple features, including sizes & summary reference axial deviations.
'                                Also names CSV file With part Name, serial number, And date-time stamp
' Notes:
'       Variable "SERNO" For Serial Number must be present In PC-DMIS part program
'        Exports CSV data To C:\YOUR_FOLDER_HERE\CSV Data Output\, change below On Line 36
'        PC-DMIS v2011 Release: when using Xactmeasure To dimension Position of multiple holes, make sure the required axis are of the Feature Set are checked.


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim Ccmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim str As String


Dim Int As Integer
Dim IntTest As String
Dim strType As String
Dim SumTest As String
Dim Int2 As Integer


Dim Headertype As Integer
HeaderType = 0




Dim Serial As Object
Set Serial = Part.GetVariableValue ("SERNO")


'Open file **** Change File Path if needed *****************************************************************************************************************************************************************


FileName = "C:\YOUR_FOLDER_HERE\" & Part.PartName & "_" & Serial.StringValue & "_"  & Month(Date) & Day(Date) & Year(Date) & "_"  & Hour(Time) & Minute(Time) & ".csv"
Open FileName For Output As #1
Print #1, "Part,Serial #,Date,Time"
Print #1, Part.PartName & "," & Serial.StringValue & "," & Month(Date) & Day(Date) & Year(Date) & ","  & Hour(Time) & Minute(Time)


'Sort Program*********************************************************************************************************************************************************************
For Each Cmd In Cmds
'...................................................... Process non-GD&T Dimensional Data ......................................................
If Cmd.Type <> 184 Then '#1
If Cmd.Type <> 1299 Then '#2
  If Cmd.IsDimension Then '#3
    If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
      Set DcmdID = Cmd.DimensionCommand
        Print #1, DcmdID.ID & ",,,,,,,,,"
    End If ' #4
    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 Then
      Set DCmd = Cmd.DimensionCommand
		'Every Dimension gets a header, just like PC-DMIS report
		Print #1, "Feature,Axis,Nominal,Plus Tol,Minus Tol,Measured,Deviation,Out Tol"
      If DCmd.ID = "" Then '#5
        str = "," & Format(DCmd.AxisLetter ,"0.0000") & "," & Format(DCmd.Nominal ,"0.0000") & "," & Format(DCmd.Plus ,"0.0000") & "," & Format(DCmd.Minus,"0.0000") & "," & Format(DCmd.Measured,"0.0000") & "," & Format(DCmd.Deviation,"0.0000") & "," & Format(DCmd.OutTol,"0.0000")
        Print #1, str
      Else
        Print #1, DCmd.ID & ",,,,,,,,,"
        str = "," & "M" & "," & Format(DCmd.Nominal ,"0.0000") & "," & Format(DCmd.Plus,"0.0000") & "," & Format(DCmd.Minus,"0.0000") & "," & Format(DCmd.Measured,"0.0000") & "," & Format(DCmd.Deviation,"0.0000") & "," & Format(DCmd.OutTol,"0.0000")
        Print #1, str
      End If '#5
    End If '#4
  End If '#3 Is dimension
End If '#2 Not Cmd.Type 1299
End If '#1Not Cmd.Type 184


'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _Process Xactmeasure GD&T _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
If Cmd.Type = 184 Then
  str = Cmd.GetText (ID, 0) 
  Print #1, str
strType = Cmd.GetText (GDT_SYMBOL, 0)


If strType = "POSITION" Then
	Print #1, "Feature,Axis,Nominal,Plus Tol,Minus Tol,Measured,Deviation,Out Tol"
  Int = 1 'Line1 Size Dimensions of Xactmeasure
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & "SIZE" & "," & Format(cdbl(Cmd.GetText (LINE1_NOMINAL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_PLUSTOL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_MINUSTOL, Int)) ,"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_MEAS, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_DEV, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE1_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
   Wend 'Line1
  Int = 1 'Line2 True Positions
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & strType & "," & "0.000" & "," & Format(cdbl(Cmd.GetText (LINE2_PLUSTOL, Int)) ,"0.0000") & "," & "0.000" & "," & Format(cdbl(Cmd.GetText (LINE2_MEAS, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_DEV, Int)),"0.000") & "," & Format(cdbl(Cmd.GetText (LINE2_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
   Wend' Line2
Int = 1 'Summary Axis Deviations For Reference
  IntTest = Cmd.GetText (SUMMARY_MEAS, Int)
   While IntTest <> ""
	str = Cmd.GetText (SUMMARY_FEAT, Int) & "," & Cmd.GetText (SUMMARY_AXIS, Int) & "," & Format(cdbl(Cmd.GetText (SUMMARY_NOMINAL, Int)) ,"0.0000") & ",,," & Format(cdbl(Cmd.GetText (SUMMARY_MEAS, Int)),"0.0000")& "," & Format(cdbl(Cmd.GetText (SUMMARY_DEV, Int)),"0.0000")
           Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (SUMMARY_MEAS, Int)
        Wend 'Summary
End If 'Position


If strType <> "POSITION" Then
'All Non-Position GD&T Get Min And Max instead of Meas And Dev
    Print #1, "Feature,Type,Nominal,Plus Tol,Minus Tol,Max,Min,Out Tol"
  Int = 1
  IntTest = Cmd.GetText (REF_ID, Int)
   While IntTest <> ""
	str = Cmd.GetText (REF_ID, Int) & "," & strType & "," & "0.0000" & "," & Format(cdbl(Cmd.GetText (LINE2_PLUSTOL, Int)) ,"0.0000") & "," & "0.0000" & "," & Format(cdbl(Cmd.GetText (LINE2_MAX, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_MIN, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_OUTTOL, Int)),"0.0000")	
        Print #1, str
	Int = Int + 1
	IntTest = Cmd.GetText (REF_ID, Int)
    Wend
  End If ' is Not Position


End If ' is Cmd.Type 184 Xactmeasure GD&T


'~~~~~~~~~~ Process Report Comments ~~~~~~~~~~ 
      If Cmd.IsComment Then
          Set Ccmd = Cmd.CommentCommand
           If Ccmd.CommentType = 1 Then
              str = Ccmd.Comment & ",,,,,,,,,"
              Print #1, str
           End If
      End If 'Comments


Next Cmd




'Save And Cleanup*******************************************************************************************************************************************************************
Close #1


End Sub

Children

No Data