BLockDef表和层

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