Author Topic: Selection Sets And Filtering  (Read 4093 times)

0 Members and 1 Guest are viewing this topic.

Robert98

  • Guest
Selection Sets And Filtering
« on: January 18, 2014, 01:38:50 AM »
Dear members HI
I have been far from autocad customization for a long time , and now I want create an array of some polyline coordinatets and then remove duplicate ones , so I wrote my routine but it have some errors at first stage .
 please show me my mistakes about it .
thanks and have a good times .
Code: [Select]
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
        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)
                myCoords(i) = Ent.Coordinates
                i = i + 1
             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



RICVBA

  • Newt
  • Posts: 62
Re: Selection Sets And Filtering
« Reply #1 on: January 30, 2014, 02:46:41 AM »
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:

Code: [Select]
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

Robert98

  • Guest
Re: Selection Sets And Filtering
« Reply #2 on: January 30, 2014, 06:17:44 PM »
Hi RECVBA
Thanks a lot for your    regards , It  seems a good idea for continuing , but I'm on a field work now and thus very soon I'm going to program .
Yous Truly, Robert