block layers to listbox

any suggestions on how to select a block and have a list box display the layers the make up the block?

 

Lunt,

Here's a little something I banged out right quick, hope it's what you need.

Joe
--

Public Sub ListBlockRefLayers()
Dim iType(0) As Integer
Dim vData(0) As Variant
Dim oSS As AcadSelectionSet
Dim Index As Long
Dim oBlock As AcadBlock
Dim oEntity As AcadEntity
Dim Count As Long

'use selectionset filter
iType(0) = 0: vData(0) = "INSERT"

On Error Resume Next
'delete any previous selection sets
ThisDrawing.SelectionSets("Inserts").Delete
On Error GoTo 0
'create new selection set
Set oSS = ThisDrawing.SelectionSets.Add("Inserts")

UserForm1.Hide
oSS.SelectOnScreen iType, vData

If oSS.Count Then
For Count = 0 To oSS.Count - 1
Set oBlock = ThisDrawing.Blocks(oSS.Item(Count).Name)

For Index = 0 To oBlock.Count - 1
ListBox1.AddItem oBlock.Item(Index).Layer
Next Index
Next Count
End If
UserForm1.Show
End Sub

layers the make up the block?

 

thanks joe...I got it......udaman

 

You're quite welcome, glad I could help.

Joe