Selection Set Rules not working for Layers (VBA)

[Anonymous]

Private Sub pline_coordinates()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim setName As String
Dim i As Integer
Dim n As Integer
Dim s As String

fcode(0) = 8                       '0                8
fData(0) = "_SP_Direk"             '"LWPOLYLINE"     "_SP_Direk"
   
dxfcode = fcode
dxfdata = fData
setName = "$Plines$"

'// make sure the selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
'// if this named selection set is already exist then delete it
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
'// add new selection set with this name
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll, , , dxfcode, dxfdata

On Error GoTo Err_Control

'// loop through the all light polylines
ReDim plineAr(0 To oSset.Count - 1, 0 To 4) As Variant
For n = 0 To oSset.Count - 1
Dim cEnt As AcadEntity
Set cEnt = oSset.Item(n)
Dim oPline As AcadLWPolyline
Set oPline = cEnt
Dim coord As Variant
'// get coordinates
coord = oPline.Coordinates
'// collect polyline handles and points into a two-dimensional array
plineAr(n, 0) = oPline.Handle
plineAr(n, 1) = coord(0) ' <--X start point
plineAr(n, 2) = coord(1) ' <--Y start point
plineAr(n, 3) = coord(UBound(coord) - 1) ' <--X end point
plineAr(n, 4) = coord(UBound(coord)) ' <--Y end point

Next n
'// clean up memory
oSset.Delete
'// do what you want with array 'plineAr' here, e.g. write data to the text file etc.

Open "C:\AllPlines.txt" For Output As #1 'Open file for output
For n = 0 To UBound(plineAr, 1)
s = ""
For i = 0 To UBound(plineAr, 2)
s = s & CStr(plineAr(n, i)) & ","
Next i
Write #1, Left(s, Len(s) - 1) 'Write comma-delimited data (cut the last comma from string)
Next n
Close #1 'Close file

Err_Control:
MsgBox Err.Description
End Sub

Hi there,

i found a code that exports all polyline coordinates to txt file.

but when i'm  trying to select a layer and export just that layer, i get an error "Type Mismatch".

it works when

fcode(0) = 0
fData(0) = "LWPOLYLINE"

[norman.yuan · Accepted solution]

Well, you did not explicitly say, but my guess is that you want to select polylines on given layer, not all polylines regardless layers. So, since you only have selection filter on layer "_SP_Direk", everything on that layer is selected. If there is anything on that layer is not AcadLWPolyline, this line of code would give you "type mismatch" error:

For n = 0 To oSset.Count - 1
    Dim cEnt As AcadEntity
    Set cEnt = oSset.Item(n)
    Dim oPline As AcadLWPolyline
    Set oPline = cEnt
    ...
Next

You should

Either include entity type filter for the selection:

Dim fcode(0 to 1) As Integer
Dim fData(0 to 1) As Variant
Dim dxfcode, dxfdata

fCode(0)=0:fCode(1)=8
fData(0)="LWPOLYLINE":fData(1)="_SP_Direk"
dxfCode=fCode
dxfData=fData
...

Or add code to test if an entity in the selectionset is AcadLWPolyline:

For n = 0 To oSset.Count - 1
    Dim cEnt As AcadEntity
    Set cEnt = oSset.Item(n)
    If TypeOf cEnt Is AcadLWPolyline Then
        Dim oPline As AcadLWPolyline
        set oPline=cEnt
        ...
    End If
Next   

HTH