hexagon logo

Mark a range

Hello all,

I'm trying to write a script that will mark a range of dimensions for vector points.
I've tried a nested For each Cmd in Cmds inside a DO UNTIL LOOP, but my
"LOOP LOGIC IS LOUSY". Disappointed

I would like to enter the range from let's say feature PT150 to feature PT300
but only mark the the corresponding dimensions for the point features in that range.
The program would initially be unmarked, script would ask what the start feature name is
and the end feature name to complete the range and then mark the dimension in that
range only.

I'm sure the Code Guru's could whip the code out in no time without all the infinite loops
I generated. Slight smile

Thanks in advance for any help

Parents
  • Good day,

    I don't know if you already have your solution, but this is how I would do it:

    Note:​
    * 'Cmd.Marked = True' marks the command for execution​ (The dimension commands are therefore executed and displayed in the report)
    * Only the dimension is displayed; the feartures are not changed
    * In my example the 'DimensionCommand' object is ignored and the command is looked at directly
    * The name of the feature entered must be exactly match

    Sub Main_230920()
    ' Dim something ---------------------------
      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
      Set Cmd = Nothing
     
      Dim sSF As String
      Dim sEF As String
      Dim bMarking As Boolean
      Dim bLast As Boolean
    
    ' get User input
      sSF = InputBox("Enter the start feature :", "StartFeature")
      sEF = InputBox("Enter the end feature :", "EndFeature")
     
    ' search
      bMarking = False
      bLast = False
      For Each Cmd In Cmds
        ' find first DIMENSION with input REF_ID "sSF"
        If (Cmd.Type = DIMENSION_START_LOCATION) And (Cmd.GetText(REF_ID, 0) = sSF) Then
          bMarking = True
        End If
        
        ' mark after find first
        If bMarking Then
          Cmd.Marked = True
        End If
        
        ' find last DIMENSION with input REF_ID "sEF"
        If (Cmd.Type = DIMENSION_START_LOCATION) And (Cmd.GetText(REF_ID, 0) = sEF) Then
          bLast = True
        End If
        
        ' exit after find last
        If (Cmd.Type = DIMENSION_END_LOCATION) And (bLast) Then
          Exit For
        End If
      Next Cmd
    
      Part.RefreshPart
    
    ' unDim something ---------------------------
      Set Cmd = Nothing
      Set Cmds = Nothing
      Set Part = Nothing
      Set App = Nothing
    End Sub​
    
Reply
  • Good day,

    I don't know if you already have your solution, but this is how I would do it:

    Note:​
    * 'Cmd.Marked = True' marks the command for execution​ (The dimension commands are therefore executed and displayed in the report)
    * Only the dimension is displayed; the feartures are not changed
    * In my example the 'DimensionCommand' object is ignored and the command is looked at directly
    * The name of the feature entered must be exactly match

    Sub Main_230920()
    ' Dim something ---------------------------
      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
      Set Cmd = Nothing
     
      Dim sSF As String
      Dim sEF As String
      Dim bMarking As Boolean
      Dim bLast As Boolean
    
    ' get User input
      sSF = InputBox("Enter the start feature :", "StartFeature")
      sEF = InputBox("Enter the end feature :", "EndFeature")
     
    ' search
      bMarking = False
      bLast = False
      For Each Cmd In Cmds
        ' find first DIMENSION with input REF_ID "sSF"
        If (Cmd.Type = DIMENSION_START_LOCATION) And (Cmd.GetText(REF_ID, 0) = sSF) Then
          bMarking = True
        End If
        
        ' mark after find first
        If bMarking Then
          Cmd.Marked = True
        End If
        
        ' find last DIMENSION with input REF_ID "sEF"
        If (Cmd.Type = DIMENSION_START_LOCATION) And (Cmd.GetText(REF_ID, 0) = sEF) Then
          bLast = True
        End If
        
        ' exit after find last
        If (Cmd.Type = DIMENSION_END_LOCATION) And (bLast) Then
          Exit For
        End If
      Next Cmd
    
      Part.RefreshPart
    
    ' unDim something ---------------------------
      Set Cmd = Nothing
      Set Cmds = Nothing
      Set Part = Nothing
      Set App = Nothing
    End Sub​
    
Children
No Data