Hi Robert98
did you overcome this issue?
otherwise let me know what you're struggling with yet.
however, at a first glance I'd notice what follows:
- it seems like you'd complain about the user who doesn't select myEnt as a LWPolyline ("MsgBox "Not selected a polyline !?", vbCritical") but, if he does select myEnt as a LWPolyline, the routine wouldn't do anything since the "if Ent.EntityType <> myEnt.EntityType" control inside "For Each Ent In SSet" loop would always return "False" (SSet.Select criteria would collect "LWPolyline" type elements only) and myCoords vector would never be filled.
So that your routine only processes coordinates belonging to LightWeightPolylines with the same color and layer of a "non LightWeightPolyline" entity: is that what you're aiming at?
- the instruction "myCoords(i)=Ent.Coordinates" wouldn't work, since "Coordinates" property gives you back a Variant. Moreover it gives you back more then one value ("coordinates for each vertex in the object") that cannot be put into one vector position only such as "myCoords(i)". Lastly you didn't use any ReDim instruction to make "myCoords" vector able to be filled with new coordinates
so you should first declare a Variant variable to collect entity coordinates and eventually pour them in your myCoords vector by means of a loop. All this always keeping track of vector dimensions (i.e.: Redimming them appropiately). like for example:
Option Explicit
Private Sub CommandButton4_Click()
Me.Hide
Dim myEnt As AcadEntity
Dim Pot(0 To 2) As Double
Dim myLay As Variant
Dim myCol As Variant
ThisDrawing.Utility.GetEntity myEnt, Pot, "Select yout lwpolyline"
If TypeOf myEnt Is AcadLWPolyline Then
myLay = myEnt.Layer
myCol = myEnt.color
Else
MsgBox "Not selected a polyline !?", vbCritical
End If
Dim SSet As AcadSelectionSet
Dim FilterType(0 To 2) As Integer
Dim FilterData(0 To 2) As Variant
Dim Groupcode As Variant
Dim DataValue As Variant
Dim myCoords() As Double
FilterType(0) = 0
FilterData(0) = "LWPolyline"
FilterType(1) = 8
FilterData(1) = myEnt.Layer
FilterType(2) = 62
FilterData(2) = myEnt.color
Groupcode = FilterType
DataValue = FilterData
On Error Resume Next
ActiveDocument.SelectionSets.Item("MY_SSL").Delete
Set SSet = ActiveDocument.SelectionSets.Add("MY_SSL")
On Error GoTo 0
SSet.Select acSelectionSetAll, , , Groupcode, DataValue
Dim Ents() As Object
Dim Ent As Object
Dim i As Long, j As Long, UBRetCoords As Long, UBMyCoords As Long
Dim retCoords As Variant
i = 0
For Each Ent In SSet
If Ent.EntityType <> myEnt.EntityType Then
ReDim Preserve Ents(0 To i)
Set Ents(i) = Ent
ReDim Preserve Ents(0 To i)
i = i + 1
retCoords = Ent.Coordinates
UBRetCoords = UBound(retCoords)
'handle the first time you have to fill myCoords
On Error Resume Next
UBMyCoords = UBound(myCoords)
If Err Then UBMyCoords = -1
On Error GoTo 0
' fill myCoords
ReDim Preserve myCoords(0 To UBMyCoords + UBRetCoords + 1)
For j = 0 To UBRetCoords
myCoords(UBMyCoords + j + 1) = retCoords(j)
Next j
End If
Next Ent
If i > 0 Then
SSet.RemoveItems (Ents)
End If
For i = 0 To UBound(myCoords) - 1
Debug.Print myCoords(i), myCoords(i + 1)
Next i
UserForm1.Show
End Sub
bye