Your Products have been synced, click here to refresh
Attribute VB_Name = "Insert Position End or Location End" Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' This script has been created by Wade Burton To replace the End command of ''' location Or True position dimensions when they somehow are missing. We ''' Do Not know how they Get removed, And is a problem when they are missing ''' because Then you can Not properly mark/unmark, delete, copy/paste these ''' dimensions. This script searches through the part program And determines ''' which dimensions are missing the End commands And inserts the End In ''' the appropriate position. Message boxes will display which dimensions ''' have been fixed. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub main() Dim app As Object Dim part As Object Dim cmds As Object Dim cmd As Object Dim dimensionCmd As Object Dim strMessage As String Dim strDimensionID As String Dim blnDimensionHasEnd As Boolean Dim intNumMissingLocationEnds As Integer Dim intNumMissingPositionEnds As Integer Dim cmdToBeInsertedAfter As Object Dim intCmdType As Integer Dim blnCmdIsMarked As Boolean Set app = CreateObject("PCDLRN.Application") Set part = app.ActivePartProgram Set cmds = part.Commands ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Sub main() intNumMissingLocationEnds = 0 intNumMissingPositionEnds = 0 For Each cmd In cmds Set intCmdType = cmd.Type blnCmdIsMarked = cmd.Marked If intCmdType = DIMENSION_START_LOCATION Or intCmdType = DIMENSION_TRUE_START_POSITION Then blnDimensionHasEnd = False Set dimensionCmd = cmd Set cmdToBeInsertedAfter = dimensionCmd strDimensionID = "Dimension ID=" & dimensionCmd.ID dimensionCmd = dimensionCmd.Next 'This dimensionCmd should be the command that follows the start of the dimension. It should be an x,y,z,pa, etc. Or an End command. 'So we search through the Next group of commands For the End command. If we hit another start dimension Or a command 'that is Not part of the current dimension we've gone too far. If no End exists Then Set the Boolean variable so later we 'can either Put up a message Or insert the End. In the numbers of axes, the End comes after the start And the straightness is the last axis In the order. Do While (dimensionCmd.Type >= DIMENSION_END_LOCATION And dimensionCmd.Type <= DIMENSION_STRAIGHTNESS_LOCATION) If (dimensionCmd.Type = DIMENSION_END_LOCATION) Then blnDimensionHasEnd = True Else Set cmdToBeInsertedAfter = dimensionCmd cmds.InsertionPointAfter cmdToBeInsertedAfter End If dimensionCmd.Next Loop Do While (dimensionCmd.Type >= DIMENSION_TRUE_END_POSITION And dimensionCmd.Type <= DIMENSION_TRUE_STRAIGHTNESS_LOCATION) If (dimensionCmd.Type = DIMENSION_TRUE_END_POSITION) Then blnDimensionHasEnd = True Else Set cmdToBeInsertedAfter = dimensionCmd cmds.InsertionPointAfter cmdToBeInsertedAfter End If dimensionCmd.Next Loop 'If we made it To the End of the dimension And didn't find an End, Then insert a new End If blnDimensionHasEnd = False And intCmdType = DIMENSION_START_LOCATION Then intNumMissingLocationEnds = intNumMissingLocationEnds + 1 strMessage = strDimensionID + " - Location dimension #" + Format(intNumMissingLocationEnds, "") MsgBox (strMessage) Set cmd = cmds.Add(DIMENSION_END_LOCATION, True) If blnCmdIsMarked = True Then cmd.Mark End If ElseIf blnDimensionHasEnd = False And intCmdType = DIMENSION_TRUE_START_POSITION Then intNumMissingPositionEnds = intNumMissingPositionEnds + 1 strMessage = strDimensionID + " - Position dimension #" + Format(intNumMissingPositionEnds, "") MsgBox (strMessage) Set cmd = cmds.Add(DIMENSION_TRUE_END_POSITION, True) If blnCmdIsMarked = True Then cmd.Mark End If End If End If Next cmd strMessage = intNumMissingLocationEnds & " Location Dimensions with missing End Commands fixed." MsgBox (strMessage) strMessage = intNumMissingPositionEnds & " Position Dimensions with missing End Commands fixed." MsgBox (strMessage) End Sub
Attribute VB_Name = "Insert Position End or Location End" Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' This script has been created by Wade Burton To replace the End command of ''' location Or True position dimensions when they somehow are missing. We ''' Do Not know how they Get removed, And is a problem when they are missing ''' because Then you can Not properly mark/unmark, delete, copy/paste these ''' dimensions. This script searches through the part program And determines ''' which dimensions are missing the End commands And inserts the End In ''' the appropriate position. Message boxes will display which dimensions ''' have been fixed. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub main() Dim app As Object Dim part As Object Dim cmds As Object Dim cmd As Object Dim dimensionCmd As Object Dim strMessage As String Dim strDimensionID As String Dim blnDimensionHasEnd As Boolean Dim intNumMissingLocationEnds As Integer Dim intNumMissingPositionEnds As Integer Dim cmdToBeInsertedAfter As Object Dim intCmdType As Integer Dim blnCmdIsMarked As Boolean Set app = CreateObject("PCDLRN.Application") Set part = app.ActivePartProgram Set cmds = part.Commands ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Sub main() intNumMissingLocationEnds = 0 intNumMissingPositionEnds = 0 For Each cmd In cmds Set intCmdType = cmd.Type blnCmdIsMarked = cmd.Marked If intCmdType = DIMENSION_START_LOCATION Or intCmdType = DIMENSION_TRUE_START_POSITION Then blnDimensionHasEnd = False Set dimensionCmd = cmd Set cmdToBeInsertedAfter = dimensionCmd strDimensionID = "Dimension ID=" & dimensionCmd.ID dimensionCmd = dimensionCmd.Next 'This dimensionCmd should be the command that follows the start of the dimension. It should be an x,y,z,pa, etc. Or an End command. 'So we search through the Next group of commands For the End command. If we hit another start dimension Or a command 'that is Not part of the current dimension we've gone too far. If no End exists Then Set the Boolean variable so later we 'can either Put up a message Or insert the End. In the numbers of axes, the End comes after the start And the straightness is the last axis In the order. Do While (dimensionCmd.Type >= DIMENSION_END_LOCATION And dimensionCmd.Type <= DIMENSION_STRAIGHTNESS_LOCATION) If (dimensionCmd.Type = DIMENSION_END_LOCATION) Then blnDimensionHasEnd = True Else Set cmdToBeInsertedAfter = dimensionCmd cmds.InsertionPointAfter cmdToBeInsertedAfter End If dimensionCmd.Next Loop Do While (dimensionCmd.Type >= DIMENSION_TRUE_END_POSITION And dimensionCmd.Type <= DIMENSION_TRUE_STRAIGHTNESS_LOCATION) If (dimensionCmd.Type = DIMENSION_TRUE_END_POSITION) Then blnDimensionHasEnd = True Else Set cmdToBeInsertedAfter = dimensionCmd cmds.InsertionPointAfter cmdToBeInsertedAfter End If dimensionCmd.Next Loop 'If we made it To the End of the dimension And didn't find an End, Then insert a new End If blnDimensionHasEnd = False And intCmdType = DIMENSION_START_LOCATION Then intNumMissingLocationEnds = intNumMissingLocationEnds + 1 strMessage = strDimensionID + " - Location dimension #" + Format(intNumMissingLocationEnds, "") MsgBox (strMessage) Set cmd = cmds.Add(DIMENSION_END_LOCATION, True) If blnCmdIsMarked = True Then cmd.Mark End If ElseIf blnDimensionHasEnd = False And intCmdType = DIMENSION_TRUE_START_POSITION Then intNumMissingPositionEnds = intNumMissingPositionEnds + 1 strMessage = strDimensionID + " - Position dimension #" + Format(intNumMissingPositionEnds, "") MsgBox (strMessage) Set cmd = cmds.Add(DIMENSION_TRUE_END_POSITION, True) If blnCmdIsMarked = True Then cmd.Mark End If End If End If Next cmd strMessage = intNumMissingLocationEnds & " Location Dimensions with missing End Commands fixed." MsgBox (strMessage) strMessage = intNumMissingPositionEnds & " Position Dimensions with missing End Commands fixed." MsgBox (strMessage) End Sub
© 2024 Hexagon AB and/or its subsidiaries. | Privacy Policy | Cloud Services Agreement |