hexagon logo
Register Sign in
  • Replies 9 replies
  • Subscribers 30 subscribers
  • Views 193 views
  • Users 0 members are here
Options
Related

Convert XactMeasure GETTEXT to expressions for geometric tolerance commands

Neil Challinor
PC-Dmis 2020 R2 saw the introduction of the geometric tolerance command which replaces the old XactMeasure. With XactMeasure it was sometimes necessary to use the GETTEXT function in to access information. The geometric tolerance command exposes much more data via the usual "dot" syntax method and, because it is a different command, the old GETTEXT references no longer work. This script converts them to their new equivalents.
Parents 
  • ' Reads through PC-Dmis routine looking GETTEXT commands that pull data from XactMeasure commands
' replaces the GETTEXT syntax With the corresponding assignment expression since GETTEXT no longer works
' For Geometric Tolerance Commands due To the introduction of the extended D-Types.
'
' Only works For GETTEXT commands where the pointer directly targets the XactMeasure dimension by Name
' For example GETTEXT(692,2,{FCFLOC14}) rather than GETTEXT(692,2,V1) Or GETTEXT(692,2,GETCOMMAND(867,"UP",1))
'
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim Cmd As Object
Dim GeoTol_Cmd, VarStr, NewStr, FeatNum, GetTxt_Enum_ID, Pntr As String
Dim VarIsNum, DimIsGeotol As Boolean

Sub main()
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
For Each Cmd In Cmds
VarIsNum = False
'
If Cmd.Type = 195 = True Then' If command is an assignment
VarStr = Cmd.GetText(134,0)' grab RH expression String

If Instr(1,VarStr,"GETTEXT") <> 0 Then' If GETTEXT assignment
GetTxt_Enum_ID = Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(40)))
GetTxt_Enum_ID = Left(GetTxt_Enum_ID,InStr(1,GetTxt_Enum_ID,chr(44) )-1)' Pull out Enumerated ID

FeatNum = Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(44)))
FeatNum = Left(FeatNum,InStr(1,FeatNum,chr(44))-1)' Pull out Index

Pntr= Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(44))-3)
Pntr= Left(Pntr,Len(Pntr)-2)' Pull out pointer

Select Case CInt(GetTxt_Enum_ID)
Case 646' LINE1_NOMINAL (nominal size e.g. dia / width)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 647' LINE1_MEAS (measured size)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 648' LINE1_PLUSTOL (size plus tol)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 649' LINE1_MINUSTOL (size minus tol)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 650' LINE1_DEV (size deviation)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 765' LINE1_OUTTOL
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw

Case 658' LINE2_BONUS
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].BTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 662' LINE2_DEV
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 695' LINE2_MAX
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MAX", 134, 0)' Update assignment
Cmd.ReDraw
Case 688' LINE2_MEAS
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 696' LINE2_MIN
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MIN", 134, 0)' Update assignment
Cmd.ReDraw
Case 694' LINE2_MINUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 687' LINE2_NOMINAL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 766' LINE2_OUTTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 693' LINE2_PLUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw

Case 669' LINE3_BONUS
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].BTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 673' LINE3_DEV
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 774' LINE3_MAX
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MAX", 134, 0)' Update assignment
Cmd.ReDraw
Case 771' LINE3_MEAS
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 775' LINE3_MIN
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MIN", 134, 0)' Update assignment
Cmd.ReDraw
Case 773' LINE3_MINUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 770' LINE3_NOMINAL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 767' LINE3_OUTTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 772' LINE3_PLUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw
End Select
End If
End If
Next Cmd

Part.RefreshPart
Set Cmd = Nothing
Set Cmds = Nothing
Set Part = Nothing
Set App = Nothing
End Sub
Reply 
  • ' Reads through PC-Dmis routine looking GETTEXT commands that pull data from XactMeasure commands
' replaces the GETTEXT syntax With the corresponding assignment expression since GETTEXT no longer works
' For Geometric Tolerance Commands due To the introduction of the extended D-Types.
'
' Only works For GETTEXT commands where the pointer directly targets the XactMeasure dimension by Name
' For example GETTEXT(692,2,{FCFLOC14}) rather than GETTEXT(692,2,V1) Or GETTEXT(692,2,GETCOMMAND(867,"UP",1))
'
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim Cmd As Object
Dim GeoTol_Cmd, VarStr, NewStr, FeatNum, GetTxt_Enum_ID, Pntr As String
Dim VarIsNum, DimIsGeotol As Boolean

Sub main()
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
For Each Cmd In Cmds
VarIsNum = False
'
If Cmd.Type = 195 = True Then' If command is an assignment
VarStr = Cmd.GetText(134,0)' grab RH expression String

If Instr(1,VarStr,"GETTEXT") <> 0 Then' If GETTEXT assignment
GetTxt_Enum_ID = Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(40)))
GetTxt_Enum_ID = Left(GetTxt_Enum_ID,InStr(1,GetTxt_Enum_ID,chr(44) )-1)' Pull out Enumerated ID

FeatNum = Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(44)))
FeatNum = Left(FeatNum,InStr(1,FeatNum,chr(44))-1)' Pull out Index

Pntr= Right(VarStr,Len(VarStr)-InStr(1,VarStr,chr(44))-3)
Pntr= Left(Pntr,Len(Pntr)-2)' Pull out pointer

Select Case CInt(GetTxt_Enum_ID)
Case 646' LINE1_NOMINAL (nominal size e.g. dia / width)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 647' LINE1_MEAS (measured size)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 648' LINE1_PLUSTOL (size plus tol)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 649' LINE1_MINUSTOL (size minus tol)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 650' LINE1_DEV (size deviation)
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 765' LINE1_OUTTOL
retval = Cmd.PutText(Pntr & ".UAME.FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw

Case 658' LINE2_BONUS
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].BTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 662' LINE2_DEV
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 695' LINE2_MAX
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MAX", 134, 0)' Update assignment
Cmd.ReDraw
Case 688' LINE2_MEAS
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 696' LINE2_MIN
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MIN", 134, 0)' Update assignment
Cmd.ReDraw
Case 694' LINE2_MINUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 687' LINE2_NOMINAL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 766' LINE2_OUTTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 693' LINE2_PLUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[1].FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw

Case 669' LINE3_BONUS
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].BTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 673' LINE3_DEV
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].DEV", 134, 0)' Update assignment
Cmd.ReDraw
Case 774' LINE3_MAX
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MAX", 134, 0)' Update assignment
Cmd.ReDraw
Case 771' LINE3_MEAS
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MEAS", 134, 0)' Update assignment
Cmd.ReDraw
Case 775' LINE3_MIN
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MIN", 134, 0)' Update assignment
Cmd.ReDraw
Case 773' LINE3_MINUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].MTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 770' LINE3_NOMINAL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].NOM", 134, 0)' Update assignment
Cmd.ReDraw
Case 767' LINE3_OUTTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].OUTTOL", 134, 0)' Update assignment
Cmd.ReDraw
Case 772' LINE3_PLUSTOL
retval = Cmd.PutText(Pntr & ".SEGMENT[2].FEATURE[" & FeatNum & "].PTOL", 134, 0)' Update assignment
Cmd.ReDraw
End Select
End If
End If
Next Cmd

Part.RefreshPart
Set Cmd = Nothing
Set Cmds = Nothing
Set Part = Nothing
Set App = Nothing
End Sub
Children
No Data
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement