Your Products have been synced, click here to refresh
' ================================================================ ' The export file format: ' FeatType,FeatName,ValueID,Meas,Theo,Dev,-Tol,+Tol,OutTol,Comment ' ================================================================ ' ' Change history ' ' 2005-11-16 PCDMIS bugs With True position: ' ' We can have OutTol <> 0 (very small number) even when Deviation = 0, also ' Deviation can be a very small number (looks like conversion artifacts Single <--> Double) ' ' If Abs(Dev) < 0.00005 Set elDev = 0 Else Set elDev = Deviation ' If Abs(OutTol) < 0.00005 Set elOutTol = 0 Else Set elOutTol = OutTol ' ' True Position can have Nominal = 0, Measured = 0 but Deviation <> 0 ' Solved by setting elAct = Nominal + elDev ' ' Note: This script does *not* handle FCF dimensions ' ================================================================ ' Dim elType As String Dim elName As String Dim elValueType As String Dim elAct As Double Dim elNom As Double Dim elDev As Double Dim elMtol As Double Dim elPtol As Double Dim elOutTol As Double Dim elComment As String Dim elStarted As Integer ' ================================================================ Sub ClearRecord elType = "type" elName = "name" elValueType = "valuetype" elAct = 0 elNom = 0 elDev = 0 elMtol = 0 elPtol = 0 elOutTol = 0 elComment = "" End Sub Sub PrintLine(FileNum%) If elStarted Then Print #FileNum, elType; ","; elName; ","; elValueType; ","; elAct; ","; elNom; ","; elDev; "," ; elMtol; ","; elPtol; ","; elOutTol; ","; elComment elStarted = 0 End If End Sub Sub ExportAsCSV(FileName$) Dim DmisApp As Object Dim DmisPart As Object Dim DmisCommands As Object Dim DmisCommand As Object Dim DmisDimension As Object Dim ix As Integer Dim fNum As Integer Dim ID As String Dim State As Integer Dim DoOutput As Integer fNum = FreeFile Open FileName$ For Output As fNum ' 2005-11-17 Print #fNum, "' FeatType,FeatName,ValueID,Meas,Theo,Dev,-Tol,+Tol,OutTol,Comment" ' ---------- Set DmisApp = CreateObject("PCDLRN.Application") Set DmisPart = DmisApp.ActivePartProgram Set DmisCommands = DmisPart.Commands elStarted = 0 State = 1 For ix = 1 To DmisCommands.Count Set DmisCommand = DmisCommands(ix) If DmisCommand.IsDimension Then Set DmisDimension = DmisCommand.DimensionCommand Select Case State Case 1 ' Normal Case If (DmisDimension.OutputMode <> DIMOUTPUT_NONE) Then DoOutput = 1 Else DoOutput = 0 End If ID = DmisDimension.ID If (DmisCommand.Type = DIMENSION_TRUE_START_POSITION) Then State = 2 ElseIf (DmisCommand.Type = DIMENSION_START_LOCATION) Then State = 3 End If If (DoOutput = 1) And (State = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If Case 2 ' True Position If (DoOutput = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If Case 3 ' Location If (DoOutput = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If End Select Set DmisDimension = Nothing ElseIf (DmisCommand.Type = DIMENSION_TRUE_END_POSITION) Then State = 1 ElseIf (DmisCommand.Type = DIMENSION_END_LOCATION) Then State = 1 End If Set DmisCommand = Nothing Next ix Set DmisCommands = Nothing Set DmisPart = Nothing Set DmisApp = Nothing PrintLine(fNum) Close #fNum Print "Klart" End Sub Sub Main(FileName$) 'ExportAsCSV(FileName$) ' For deployment ExportAsCSV("EXPORT.TXT") ' For testing End Sub
' ================================================================ ' The export file format: ' FeatType,FeatName,ValueID,Meas,Theo,Dev,-Tol,+Tol,OutTol,Comment ' ================================================================ ' ' Change history ' ' 2005-11-16 PCDMIS bugs With True position: ' ' We can have OutTol <> 0 (very small number) even when Deviation = 0, also ' Deviation can be a very small number (looks like conversion artifacts Single <--> Double) ' ' If Abs(Dev) < 0.00005 Set elDev = 0 Else Set elDev = Deviation ' If Abs(OutTol) < 0.00005 Set elOutTol = 0 Else Set elOutTol = OutTol ' ' True Position can have Nominal = 0, Measured = 0 but Deviation <> 0 ' Solved by setting elAct = Nominal + elDev ' ' Note: This script does *not* handle FCF dimensions ' ================================================================ ' Dim elType As String Dim elName As String Dim elValueType As String Dim elAct As Double Dim elNom As Double Dim elDev As Double Dim elMtol As Double Dim elPtol As Double Dim elOutTol As Double Dim elComment As String Dim elStarted As Integer ' ================================================================ Sub ClearRecord elType = "type" elName = "name" elValueType = "valuetype" elAct = 0 elNom = 0 elDev = 0 elMtol = 0 elPtol = 0 elOutTol = 0 elComment = "" End Sub Sub PrintLine(FileNum%) If elStarted Then Print #FileNum, elType; ","; elName; ","; elValueType; ","; elAct; ","; elNom; ","; elDev; "," ; elMtol; ","; elPtol; ","; elOutTol; ","; elComment elStarted = 0 End If End Sub Sub ExportAsCSV(FileName$) Dim DmisApp As Object Dim DmisPart As Object Dim DmisCommands As Object Dim DmisCommand As Object Dim DmisDimension As Object Dim ix As Integer Dim fNum As Integer Dim ID As String Dim State As Integer Dim DoOutput As Integer fNum = FreeFile Open FileName$ For Output As fNum ' 2005-11-17 Print #fNum, "' FeatType,FeatName,ValueID,Meas,Theo,Dev,-Tol,+Tol,OutTol,Comment" ' ---------- Set DmisApp = CreateObject("PCDLRN.Application") Set DmisPart = DmisApp.ActivePartProgram Set DmisCommands = DmisPart.Commands elStarted = 0 State = 1 For ix = 1 To DmisCommands.Count Set DmisCommand = DmisCommands(ix) If DmisCommand.IsDimension Then Set DmisDimension = DmisCommand.DimensionCommand Select Case State Case 1 ' Normal Case If (DmisDimension.OutputMode <> DIMOUTPUT_NONE) Then DoOutput = 1 Else DoOutput = 0 End If ID = DmisDimension.ID If (DmisCommand.Type = DIMENSION_TRUE_START_POSITION) Then State = 2 ElseIf (DmisCommand.Type = DIMENSION_START_LOCATION) Then State = 3 End If If (DoOutput = 1) And (State = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If Case 2 ' True Position If (DoOutput = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If Case 3 ' Location If (DoOutput = 1) Then PrintLine(fNum) ClearRecord elType = DmisCommand.TypeDescription elName = ID ' 2005-11-17 If DmisDimension.AxisLetter = "D" Then elValueType = "DIAM" Elseif DmisDimension.AxisLetter = "R" Then elValueType = "RAD" Else elValueType = DmisDimension.AxisLetter End If ' --------- elNom = DmisDimension.Nominal ' 2005-11-16 If (Abs(DmisDimension.Deviation) > 0.00005) Then elDev = DmisDimension.Deviation Else elDev = 0 End If elAct = DmisDimension.Nominal + elDev ' --------- elMtol = -DmisDimension.Minus elPtol = DmisDimension.Plus ' 2005-11-16 If (Abs(DmisDimension.OutTol) > 0.00005) Then elOutTol = DmisDimension.OutTol Else elOutTol = 0 End If ' --------- elComment = "" elStarted = 1 End If End Select Set DmisDimension = Nothing ElseIf (DmisCommand.Type = DIMENSION_TRUE_END_POSITION) Then State = 1 ElseIf (DmisCommand.Type = DIMENSION_END_LOCATION) Then State = 1 End If Set DmisCommand = Nothing Next ix Set DmisCommands = Nothing Set DmisPart = Nothing Set DmisApp = Nothing PrintLine(fNum) Close #fNum Print "Klart" End Sub Sub Main(FileName$) 'ExportAsCSV(FileName$) ' For deployment ExportAsCSV("EXPORT.TXT") ' For testing End Sub
© 2024 Hexagon AB and/or its subsidiaries. | Privacy Policy | Cloud Services Agreement |