list of all object for one layer - VBA

[Anonymous]

what's the best way to get list (AcadSelectionSet) of all objects presented
in one layer using VBA

thanks a lot

[Anonymous]

Try this out...........

Sub allonspecifiedlayer()
' This routine allows the user to select everything on screen. Then it
goes through all
' of the objects one by one and puts them in a list along with the layer
name.
' Need to create a form called objectsfrm and add a listbox called
listbox1 to form.


'dimension these variables
Dim ssetObj As AcadSelectionSet
Dim sset As AcadSelectionSets
Dim acadobj As AcadObject
Dim objname As String
Dim objlayer As String
Dim I As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double

corner1(0) = -10000000000#: corner1(1) = -10000000000#: corner1(2) = 0
corner2(0) = 10000000000#: corner2(1) = 10000000000#: corner2(2) = 0

I = 0
objectsfrm.ListBox1.ColumnCount = 3

Set sset = ThisDrawing.SelectionSets

For Each ssetObj In sset
If UCase(ssetObj.Name) = "TEST" Then
sset.Item("TEST").Delete
Exit For
End If
Next

Set ssetObj = ThisDrawing.SelectionSets.Add("TEST")

' Add all the objects to the selection set
ssetObj.Select acSelectionSetAll

For Each acadobj In ssetObj
'Filter out everything on specified layer.
If acadobj.Layer = "L004" Then
objname = acadobj.ObjectName
objlayer = acadobj.Layer
objectsfrm.ListBox1.AddItem objname
objectsfrm.ListBox1.List(I, 1) = objlayer
I = I + 1
End If
Next acadobj
'Show form
objectsfrm.Show

End Sub

Martin


"Jaroslav Adamec" wrote in message
news:F39C362B75A13827D6A499A4D5902E44@in.WebX.maYIadrTaRb...
> what's the best way to get list (AcadSelectionSet) of all objects
presented
> in one layer using VBA
>
> thanks a lot
>
>

[Anonymous]

Jaroslav Adamec wrote:
> what's the best way to get list (AcadSelectionSet) of all objects
> presented in one layer using VBA

The answer is a filtered selection set:

Dim ss As AcadSelectionSet, fType, fData

Set ss = CreateSelectionSet()
Call BuildFilter(fType, fData, 0, "SomeLayerName")
ss.Select acSelectionSetAll, , , fType, fData

Links:

CreateSelectionSet: http://code.acadx.com/visualbasic/010.htm
BuildFilter: http://code.acadx.com/visualbasic/004.htm

To learn more about filtered selection sets, first visit the VBA online
help for selection set objects then view the DXF Reference in the
VisualLISP online help.

--
"It's more important that you know how to find the answer than to have
the answer." - Me

[Anonymous]

Hey there,

I tried your code but it is built on two other subs or functions that are not shown in the post... so I tried the link where they were supposed to be hosted, but the links have expired in the 15 years since your post.

Darn it.

[Ed__Jobe]

Frank hasn't been around for years, but the subs are simple. Here are my versions.

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for when you want to create a
' selectin set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
    On Error Resume Next
    Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
    If Err.Number <> 0 Then
        Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
        AddSelectionSet.Clear
    End If
End Function

Public Sub BuildFilter(typeArray As Variant, dataArray As Variant, ParamArray gCodes())

'Purpose
'Fills a pair of variants with arrays for use as a selection set filter
'
'Arguments
'Two variants (not variant arrays) and an unlimited number of group code / value pairs
'
'Example
'BuildFilter fType, fData, 0, "LINE", 7, "WALLS"

    Dim fType() As Integer, fData()
    Dim index As Long, i As Long
    
    index = LBound(gCodes) - 1
        
    For i = LBound(gCodes) To UBound(gCodes) Step 2
        index = index + 1
        ReDim Preserve fType(0 To index)
        ReDim Preserve fData(0 To index)
        fType(index) = CInt(gCodes(i))
        fData(index) = gCodes(i + 1)
    Next
    typeArray = fType: dataArray = fData

End Sub