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 "V_SERIALNUMBER" 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 ("V_SERIALNUMBER")
Set LotNo = Part.GetVariableValue ("V_LOT")
'Open file **** Change File Path If needed *****************************************************************************************************************************************************************
'FileName = "J:\CMM\Data Export\" & Part.PartName & "_" & Serial.StringValue & "_" & Month(Date) & Day(Date) & Year(Date) & "_" & Hour(Time) & Minute(Time) & ".csv"
FileName = "J:\CMM\Data Export\" & Part.PartName & "_Lot " & LotNo.StringValue & "_Min-Max_Output" & ".csv"
Open FileName For Output As #1
Print #1, "Part,Lot #,Serial #,Date,Time"
Print #1, Part.PartName & "," & LotNo.StringValue & "," & Serial.StringValue & "," & Month(Date) & Day(Date) & Year(Date) & "," & Hour(Time) & Minute(Time)
'Sort Program*********************************************************************************************************************************************************************
For Each Cmd In Cmds
'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _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
'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"
Print #1, "Measured,Max,Min"
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")
str = Format(cdbl(Cmd.GetText (LINE2_MEAS, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_MAX, Int)),"0.0000") & "," & Format(cdbl(Cmd.GetText (LINE2_MIN, 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
