VBA - Selection within a poline

[Anonymous]

Hello,

I have this VBA code to select objects within a polyline. It used to work fine, then stopped. Now it only displays the number of items within the polyline in the comand line. I also have the simliar code to earase objects within a polyline, and it works just fine.

Any ideas on how to get this to work?

Code for selection:

Public Sub SELECTCLIP()

Dim plineObj As AcadLWPolyline
Dim object As Object
Dim returnObj As AcadObject
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
Dim basePnt As Variant


On Error Resume Next

ThisDrawing.Utility.GetSubEntity object, PickedPoint, TransMatrix, "Please select xref polyline:"

'If Err <> 0 Then
'MsgBox "The user did not click on an Entity.(Pressed Esc. or clicked on nothing.....)"
'Exit Sub
'End If

On Error GoTo 0

'If returnObj.ObjectName <> "AcDbPolyline" Then
'MsgBox "The user selected an object, but it's not a polyline."
'Exit Sub
'End If

Set plineObj = object

Dim sset As AcadSelectionSet
For Each sset In ThisDrawing.SelectionSets
If sset.Name = "BlockPolylineSSet" Then
Exit For
End If
Next sset
If sset Is Nothing Then
Set sset = ThisDrawing.SelectionSets.Add("BlockPolylineSSet")
Else
sset.Clear
End If


Dim i As Integer, j As Integer
Dim Coords() As Double
ReDim Coords(0 To ((UBound(plineObj.Coordinates) + 1) * 1.5) - 1)
j = 0
For i = 0 To UBound(plineObj.Coordinates) Step 2
Coords(j) = plineObj.Coordinates(i)
j = j + 1
Coords(j) = plineObj.Coordinates(i + 1)
j = j + 1
Coords(j) = 0
j = j + 1
Next i


sset.SelectByPolygon acSelectionSetWindowPolygon, Coords

ThisDrawing.SendCommand "_.select" + vbCr + "p" + vbCr + vbCr


   
Exit Sub

End Sub

Code to earas within a polyline:

Public Sub ERASECLIP()

Dim plineObj As AcadLWPolyline
Dim object As Object
Dim returnObj As AcadObject
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
Dim basePnt As Variant


On Error Resume Next

ThisDrawing.Utility.GetSubEntity object, PickedPoint, TransMatrix, "Please select xref polyline:"

'If Err <> 0 Then
'MsgBox "The user did not click on an Entity.(Pressed Esc. or clicked on nothing.....)"
'Exit Sub
'End If

On Error GoTo 0

'If returnObj.ObjectName <> "AcDbPolyline" Then
'MsgBox "The user selected an object, but it's not a polyline."
'Exit Sub
'End If

Set plineObj = object

Dim sset As AcadSelectionSet
For Each sset In ThisDrawing.SelectionSets
If sset.Name = "BlockPolylineSSet" Then
Exit For
End If
Next sset
If sset Is Nothing Then
Set sset = ThisDrawing.SelectionSets.Add("BlockPolylineSSet")
Else
sset.Clear
End If


Dim i As Integer, j As Integer
Dim Coords() As Double
ReDim Coords(0 To ((UBound(plineObj.Coordinates) + 1) * 1.5) - 1)
j = 0
For i = 0 To UBound(plineObj.Coordinates) Step 2
Coords(j) = plineObj.Coordinates(i)
j = j + 1
Coords(j) = plineObj.Coordinates(i + 1)
j = j + 1
Coords(j) = 0
j = j + 1
Next i


sset.SelectByPolygon acSelectionSetWindowPolygon, Coords

ThisDrawing.SendCommand "_.erase" + vbCr + "p" + vbCr + vbCr

sset.Clear

sset.Delete
   
Exit Sub

End Sub

Thanks in advnace

[Anonymous]

Hard to tell.

What's the last thing your command line says after the code completes? 

Have you tried using debug stops to track how far the code makes it before dropping out?
Have you tried commenting out your error handling and seeing if any lines return an error? 

Have the polylines changed in any way recently? Have you tried to run the code on some polylines that the code has worked on before? (This code is only set up to handle lightweight polylines) 

[Anonymous]

After excuting the code, the command line reads " # Found". Attached is a screen shot showing the closed polyline, and the command line after running the code.

I tried to debug, but the code just through with no error.

I haven't made anychanges. It was working fine last night, I came in this morning and it's not working.

[Anonymous]

I'm thinking it's one of two things (though, why it worked yesterday but not today, I'm not quite sure).

Unless you had hit escape or enter before taking that screenshot, it looks like your code causes the select command to end. Try taking out one of the vbCr commands at the end there. When you manually type into the command line: Select, enter, p, enter, it ends with the previous selection selected. when you press enter again (vbCr in the code), it deselects. So maybe take out the last vbCr, leaving this:

ThisDrawing.SendCommand "_.select" + vbCr + "p" + vbCr

I think this explains why it works for erasing but not selecting. Your code to delete lines actually deletes the lines on the first vbCr, while selecting selects on the first vbCr, then deselects on the second. 

If that doesn't work, it may be that the objects are selected, but due to a linetype/ltscale issue, you can't tell that they're selected. Try running the vba script then without hitting escape, hit erase or something and see if the objects were actually selected. 

And if neither of those work, maybe an acceptable workaround for you is to just run the script, then immediately after, press space, p, space, which essentially just runs the Select -> Previous command again. 

[Anonymous]

Is your erase function just a way to delete segments from plines? Were you aware that you could use trim to do that? Just run the trim command, select the pline itself as your trimming objects, then click any segments you want to remove. 

[norman.yuan]

The most possible cause of your issue could be because of using AcadDocument.SemdCommand() iin both the selecting code and the code that tries to use the selection built by previous SendCommand().

If you use code to have a selection set created, you can go ahead to do whatever you want to with the entities ini the selection set, such as erasing, moving...with code easily without having to call AcadDocument.SendCommand(). Depending on AutoCAD's current state, things done by SendCommand() may not be in sync with the code that calls SendCommand().

The other possibility of your code sometimes works, sometimes not may be the result of the polygon used for the selection is not ENTIRELY viewable in the current view. When using AcadSelectionSet.SelectByPolygon(), the polygon, window or fence must be not exceed current view. A good practice is to write code to zoom to the polygon/window/fence, so that the entire polygon/window/fence is no bigger than the current view, before calling SelectByPolygon()

In your case, in the subroutine "SELECTCLIP", instead of call SendCommand in the last line of cose (in order to create a set of selected entities), you simply return the created AcadSelectionSet for next step of execution. Something like:

Public Function SELECTCLIP() As AcadSelectionSet

    ....

    ....

    sset.SelectByPolygon.......

    Set SELECTCLIP=sset

End Function

Then in your erasing subroutine:

Public Sub ERASECLIP()

    Dim ent As AcadEntity

    Dim sset As AcadSelectionSet

    ''You need to make sure the polygon must be ENTIRELY viewable 

    ''in current view before calling SelectByPolygon

    Set sset=SELECTCLIP()

    If sset.Count>0 Then

        For Each ent In sset

          ent.Delete

        Next

    End If

    sset.Delete

End Sub

[1994ghuge]

im getting error with this program can u help me

object variable is not set with block variable