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".

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.

Thanks in advance for any help

Parents

Henniger123 over 1 year ago

Hello,

changed it

    ' mark after find first
    If bMarking Then     ' <- here is the mistake
      Cmd.Marked = True
    End If

   ' should be:
    If ((bMarking) And (Cmd.IsDimension)) Or ((bMarking) And (Cmd.Type = DIMENSION_END_LOCATION)) Then
      Cmd.Marked = True
    End If

updated:

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) And (Cmd.IsDimension)) Or ((bMarking) And (Cmd.Type = DIMENSION_END_LOCATION)) Then
      Cmd.Marked = True
    End If    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

Henniger123 over 1 year ago

Hello,

changed it

    ' mark after find first
    If bMarking Then     ' <- here is the mistake
      Cmd.Marked = True
    End If

   ' should be:
    If ((bMarking) And (Cmd.IsDimension)) Or ((bMarking) And (Cmd.Type = DIMENSION_END_LOCATION)) Then
      Cmd.Marked = True
    End If

updated:

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) And (Cmd.IsDimension)) Or ((bMarking) And (Cmd.Type = DIMENSION_END_LOCATION)) Then
      Cmd.Marked = True
    End If    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