访问动态块定义中的可见性特性

Function GetExtents(Block As AcadBlock, SubjectDwg As AcadDocument, Optional View As String) As Double()
Dim Obj As AcadEntity
Dim MinExt(0 To 1) As Variant 'minimum bounding extents of block
Dim MaxExt(0 To 1) As Variant 'maximum bounding extents of block
Dim ObjMinExt As Variant
Dim ObjMaxExt As Variant
Dim TempArray() As Double
ReDim TempArray(0 To 3)
For Each Obj In Block
    Select Case Obj.EntityName
            Case "AcDbTable"
                'ignore
            Case "AcDbBlockReference"
                TempArray = GetExtents(SubjectDwg.Blocks.Item(Obj.Name), SubjectDwg)
            Case "AcDbPolyline", "AcDbLine", "AcDbArc", "AcDbCircle"
                If UCase(Obj.Layer) Like "CENTRELINES" Or UCase(Obj.Layer) Like "*-C" Or UCase(Obj.Layer) Like "*-CLEAR" Then
                 'ignore
                ElseIf obj.visilitystate  View then #########################  MaxExt(0) Then
                        MaxExt(0) = ObjMaxExt(0)
                    End If
                    If ObjMaxExt(1) > MaxExt(1) Then
                        MaxExt(1) = ObjMaxExt(1)
                    End If
                    If MinExt(0) > ObjMinExt(0) Then
                        MinExt(0) = ObjMinExt(0)
                    End If
                    If MinExt(1) > ObjMinExt(1) Then
                        MinExt(1) = ObjMinExt(1)
                    End If
                End If
        End Select
Next Obj
TempArray(0) = MinExt(0)
TempArray(1) = MinExt(1)
TempArray(2) = MaxExt(0)
TempArray(3) = MaxExt(1)
GetExtents = TempArray()
        
End Function

get block references
get block definition (regardless of dynamic or other)
go through the entities getting visibility and grow your bounding box
-skip non constant attributes
transform bounding box by block ref transform
go through attribute collection, grow bounding box for each visible attribute
~et voila~