IsLayout Пример

Sub Example_IsLayout()
    ' Этот пример циклически проходит каждый объект Block в рисунке и
    ' определяет ли стиль каждого Block, обращаясь к IsLayout и свойствам
    ' IsXRef. Объект Block также добавлен во время выполнения, таким
    ' образом результаты смешаны и не только исходят из Блоков по
    ' умолчанию.
    
    Dim circleObj As AcadCircle
    Dim centerPoint(0 To 2) As Double, InsertPoint(0 To 2) As Double
    Dim radius As Double
    Dim newBlock As AcadBlock, insertedBlock As AcadBlockReference
    Dim tempBlock As AcadBlock
    Dim msg As String
    
    'Определите объект Circle, который будет вставлен в блок
    centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
    InsertPoint(0) = 1: InsertPoint(1) = 1: InsertPoint(2) = 0
    radius = 0.5
    
    'Создайте новый блок, чтобы держать объект Circle
    Set newBlock = ThisDrawing.Blocks.Add(centerPoint, "CBlock")
    
    'Добавьте объект Circle к новому объекту блока
    Set circleObj = ThisDrawing.Blocks("CBlock").AddCircle(centerPoint, radius)
    
    'Добавьте новый блок к пространству модели
    Set insertedBlock = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, "CBlock", 1, 1, 1, 0)
        
    ThisDrawing.Application.ZoomAll
    
    msg = vbCrLf & vbCrLf
    
    For Each tempBlock In ThisDrawing.Blocks
        If Not (tempBlock.IsLayout) And Not (tempBlock.IsXRef) Then
            'Block простой
            msg = msg & tempBlock.name & ": Простой"
        ElseIf tempBlock.IsXRef Then
            'Block - внешняя ссылка
            msg = msg & tempBlock.name & ": Внешняя ссылка"
            If tempBlock.IsLayout Then
                'Block также содержит геометрию листа
                msg = msg & tempBlock.name & " и Содержит Геометрию Листа"
            End If
        ElseIf tempBlock.IsLayout Then
            'Block содержит геометрию листа
            msg = msg & tempBlock.name & ": Содержит Геометрию Листа"
        End If
        
        msg = msg & vbCrLf      ' Двигайтесь в следующую линию
    Next
        
    'Информация Block отображения для этого рисунка
    MsgBox "Блоки в этом рисунке имеют следующие стили: " & msg

End Sub
Сайт управляется системой uCoz