Joro, that's a nice try, but you may want to look at the way you are redimming
If you are interested below code makes a benchmark block, to insert in a drawing then running tch you can check the times on each method
I get 0.2792969 for your method
0.1601563 using BlocklayerswithCol ent
Sub tch()
Dim P
Dim ent As AcadEntity
ThisDrawing.Utility.GetEntity ent, P, "Pick a blockref"
If Not TypeOf ent Is AcadBlockReference Then Exit Sub
If ent Is Nothing Then Exit Sub
Dim t As Single
t = Timer
Blocklayers ent
'BlocklayerswithCol ent
Debug.Print Timer - t
End Sub
Sub Blocklayers(ent As AcadEntity)
Dim b As AcadBlock
Dim UsedLayers() As String
Dim N As Double
Dim P
Dim i As Double
Dim Found As Boolean
Dim msg As String
Set b = ThisDrawing.Blocks(ent.Name)
N = -1
For Each ent In b
If N = -1 Then
N = N + 1
ReDim UsedLayers(N)
UsedLayers(N) = ent.Layer
msg = msg & vbCr & ent.Layer
Else
Found = False
For i = 0 To UBound(UsedLayers)
If UsedLayers(i) = ent.Layer Then
Found = True
Exit For
End If
Next
If Found = False Then
N = N + 1
ReDim Preserve UsedLayers(N)
UsedLayers(N) = ent.Layer
msg = msg & vbCr & ent.Layer
End If
End If
Next
'MsgBox "Layers used in the block:" & vbCr & msg
End Sub
Sub BlocklayerswithCol(ent As AcadEntity)
Dim b As AcadBlock
Dim LayerCol As New Collection
Dim slayer As String
Dim i As Integer
Dim msg As String
Set b = ThisDrawing.Blocks(ent.Name)
For Each ent In b
slayer = ent.Layer
For i = 1 To LayerCol.count
If LayerCol(i) = slayer Then GoTo skip
Next
LayerCol.Add slayer
skip:
Next
For i = 1 To LayerCol.count
msg = msg & vbCr & LayerCol(i)
Next
'MsgBox "Layers used in the block:" & vbCr & msg
End Sub
Sub addblockandlayers()
Dim b As AcadBlock
Dim l As AcadLayer
Dim ls As AcadLayers
Dim bs As AcadBlocks
Set ls = ThisDrawing.LAYERS
Set bs = ThisDrawing.Blocks
Set b = bs.Add(Zero, "b")
Dim c As AcadCircle
Dim i As Integer
Dim cen(2) As Double
For i = 1 To 250
Set l = ThisDrawing.LAYERS.Add(i)
l.Color = i
cen(0) = i
Set c = b.AddCircle(cen, 5)
c.Layer = i
Set c = b.AddCircle(cen, 3)
c.Layer = i
Next
End Sub