Script to pull nominal and tols

I am attempting to have a script create a csv file for later use. What I would like is to gain the output_id, and for each respective axis it reports obtain the nom, ptol, mtol.
Currently I have modified some script and what I found is when I have a location/tp output the output_id appears with 0,0,0. Then in the next 'instance' the output_id = 0 and I get the appropriate nom, ptol, mtol value. Almost every other output style (in legacy) will pull the output_id, nom, ptol, mtol without a gap. Here is the code I am using so far:

Dim Axs As String, Nom As String, Oid As String, Uptol As String, Lowtol As String

Part_S = ""
i = 0
For Each Cmd In DmisCommands
If Cmd.IsDimension Then
k = k + 1
Set dcmd = Cmd.dimensioncommand
Ax_s = Cmd.TypeDescription
O_id = CStr(dcmd.ID)
No_m = CStr(dcmd.Nominal)
Up_tol = CStr(dcmd.Plus)
Low_tol = CStr(dcmd.Minus)

If Ax_s = "Datum Definition" Then
GoTo Skip
End If

If Ax_s = "Dimension Position" Or Ax_s = "Dimension Location" Then
O_id_h = O_id
Mult_i = "True"
i = i+1
Else
Mult_i = "False"
i = 0
End If

If Mult_i = "False" Then
If k = 1 Then
Part_S = O_id & "," & No_m & "," & Up_tol & "," & Low_tol
End If
If k > 1 Then
Part_S = Part_S & "," & O_id & "," & No_m & "," & Up_tol & "," & Low_tol
End If
End If
If Mult_i = "True" Then
If k = 1 Then
Part_S = O_id_h
End If
If k > 1 Then
Part_S = Part_S & "," & O_id_h & "," & No_m & "," & Up_tol & "," & Low_tol
End If
End If

Skip:
End If
Next Cmd
Part_S = SerNum & "," & Part_S

Private Sub MakeStatusFile()
Open INFOPath For Append As #1
Print #1, Part_S
Close #1
Exit Sub
End Sub

For example the following output will appear as "LOC_FORM",0,0,0,,"5.4756","4.0000","0.002",,"0","5.0000","0":

DIM LOC_FORM= LOCATION OF CIRCLE CIR_A1 UNITS=IN ,$
GRAPH=OFF TEXT=OFF MULT=10.00 OUTPUT=BOTH HALF ANGLE=NO
AX MEAS NOMINAL +TOL -TOL DEV OUTTOL
D 5.47560 5.47560 4.00000 0.00200 0.00000 0.00000 #---
RN 0.00000 0.00000 5.00000 0.00000 0.00000 0.00000 #---
END OF DIMENSION LOC_FORM

I'd like it to be: "LOC_FORM","5.4756","4.0000","0.002","LOC_FORM","0","5.0000","0"
TYIA

Parents

Henniger123 over 3 years ago

Hi,

i think this should work " ExtractDim.Txt "

you can change the output pattern to your preferences

Sub Main()
' --- Error ------------------------------------------------------------------------------
On Error GoTo ErrorHandler


' --- Dim something ------------------------------------------------------------------------------
Dim retval
Dim vpcDMIS_App, vpcDMIS_Part, vpcDMIS_Cmds, vpcDMIS_Cmd As Object

Set vpcDMIS_App = CreateObject("PCDLRN.Application")
Set vpcDMIS_Part = vpcDMIS_App.ActivePartProgram
Set vpcDMIS_Cmds = vpcDMIS_Part.Commands
Set vpcDMIS_Cmd = Nothing

Dim bStart As Boolean
Dim iLoopIndex, iFound As Integer
Dim sID, sOutput, INFOPath As String



' --- save part ------------------------------------------------------------------------------------
vpcDMIS_Part.Save




' --- search Commands ------------------------------------------------------------------------------
iLoopIndex = 0
iFound = 0
For Each vpcDMIS_Cmd In vpcDMIS_Cmds
iLoopIndex = iLoopIndex + 1


' *** user info **************
vpcDMIS_App.StatusBar = "Script: Cycling through commands. Current command: " & iLoopIndex
Set vpcDMIS_Cmd = vpcDMIS_Cmds.Item(iLoopIndex)


' *** test for Marked **************
If vpcDMIS_Cmd.Marked = False Then ' ignore all Marked commands
GoTo NextLoop
End If


' *** find DIMENSION_START_LOCATION **************
If vpcDMIS_Cmd.Type = DIMENSION_START_LOCATION Then
bStart = True
sID = vpcDMIS_Cmd.GetText(ID, 0)

GoTo NextLoop
End If


' *** find DIMENSION_LOCATION **************
'sOutput = "ID; AX; NOMINAL; +Tol; -Tol; DEV; OUTTOL"
If bStart And vpcDMIS_Cmd.IsDimension Then
iFound = iFound + 1

sOutput = sOutput & sID & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(Axis, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(Nominal, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(F_PLUS_TOL, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(F_MINUS_TOL, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(DIM_DEVIATION, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(DIM_OUTTOL, 0)
sOutput = sOutput & Chr(13) & Chr(10)
GoTo NextLoop
End If


' *** find DIMENSION_END_LOCATION **************
If vpcDMIS_Cmd.Type = DIMENSION_START_LOCATION Then
bStart = False
sID = ""
GoTo NextLoop
End If


NextLoop:
Next vpcDMIS_Cmd


' --- print output --------------------------------------------------------------------------------
If sOutput <> "" Then
sOutput = "ID; AX; NOMINAL; +Tol; -Tol; DEV; OUTTOL" & Chr(13) & Chr(10) & sOutput

MsgBox sOutput

'Open INFOPath For Append As #1
'Print #1, sOutput
'Close #1
End If


' --- end -----------------------------------------------------------------------------------------
ErrorHandler:
vpcDMIS_App.StatusBar = "Script: " & CStr(iLoopIndex) & " searched commands | Found Dimension: " & CStr(iFound)


' --- free something ------------------------------------------------------------------------------
Set vpcDMIS_Cmd = Nothing
Set vpcDMIS_Cmds = Nothing
Set vpcDMIS_Part = Nothing
Set vpcDMIS_App = Nothing
End Sub

Reply

Henniger123 over 3 years ago

Hi,

i think this should work " ExtractDim.Txt "

you can change the output pattern to your preferences

Sub Main()
' --- Error ------------------------------------------------------------------------------
On Error GoTo ErrorHandler


' --- Dim something ------------------------------------------------------------------------------
Dim retval
Dim vpcDMIS_App, vpcDMIS_Part, vpcDMIS_Cmds, vpcDMIS_Cmd As Object

Set vpcDMIS_App = CreateObject("PCDLRN.Application")
Set vpcDMIS_Part = vpcDMIS_App.ActivePartProgram
Set vpcDMIS_Cmds = vpcDMIS_Part.Commands
Set vpcDMIS_Cmd = Nothing

Dim bStart As Boolean
Dim iLoopIndex, iFound As Integer
Dim sID, sOutput, INFOPath As String



' --- save part ------------------------------------------------------------------------------------
vpcDMIS_Part.Save




' --- search Commands ------------------------------------------------------------------------------
iLoopIndex = 0
iFound = 0
For Each vpcDMIS_Cmd In vpcDMIS_Cmds
iLoopIndex = iLoopIndex + 1


' *** user info **************
vpcDMIS_App.StatusBar = "Script: Cycling through commands. Current command: " & iLoopIndex
Set vpcDMIS_Cmd = vpcDMIS_Cmds.Item(iLoopIndex)


' *** test for Marked **************
If vpcDMIS_Cmd.Marked = False Then ' ignore all Marked commands
GoTo NextLoop
End If


' *** find DIMENSION_START_LOCATION **************
If vpcDMIS_Cmd.Type = DIMENSION_START_LOCATION Then
bStart = True
sID = vpcDMIS_Cmd.GetText(ID, 0)

GoTo NextLoop
End If


' *** find DIMENSION_LOCATION **************
'sOutput = "ID; AX; NOMINAL; +Tol; -Tol; DEV; OUTTOL"
If bStart And vpcDMIS_Cmd.IsDimension Then
iFound = iFound + 1

sOutput = sOutput & sID & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(Axis, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(Nominal, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(F_PLUS_TOL, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(F_MINUS_TOL, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(DIM_DEVIATION, 0) & ";"
sOutput = sOutput & vpcDMIS_Cmd.GetText(DIM_OUTTOL, 0)
sOutput = sOutput & Chr(13) & Chr(10)
GoTo NextLoop
End If


' *** find DIMENSION_END_LOCATION **************
If vpcDMIS_Cmd.Type = DIMENSION_START_LOCATION Then
bStart = False
sID = ""
GoTo NextLoop
End If


NextLoop:
Next vpcDMIS_Cmd


' --- print output --------------------------------------------------------------------------------
If sOutput <> "" Then
sOutput = "ID; AX; NOMINAL; +Tol; -Tol; DEV; OUTTOL" & Chr(13) & Chr(10) & sOutput

MsgBox sOutput

'Open INFOPath For Append As #1
'Print #1, sOutput
'Close #1
End If


' --- end -----------------------------------------------------------------------------------------
ErrorHandler:
vpcDMIS_App.StatusBar = "Script: " & CStr(iLoopIndex) & " searched commands | Found Dimension: " & CStr(iFound)


' --- free something ------------------------------------------------------------------------------
Set vpcDMIS_Cmd = Nothing
Set vpcDMIS_Cmds = Nothing
Set vpcDMIS_Part = Nothing
Set vpcDMIS_App = Nothing
End Sub

Children

No Data