IsXRef Пример

Sub Example_IsXRef()
    ' Этот пример циклически проходит каждый объект 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
            'Блок прост
            msg = msg & tempBlock.name & ": Простой"
        ElseIf tempBlock.IsXRef Then
            ' Block is an external reference
            msg = msg & tempBlock.name & ": Внешняя ссылка"
            If tempBlock.IsLayout Then
                'Блок также содержит геометрию листа
                msg = msg & tempBlock.name & " и Содержит Геометрию Листа"
            End If
        ElseIf tempBlock.IsLayout Then
            'Блок содержит геометрию листа
            msg = msg & tempBlock.name & ": Содержит Геометрию Листа"
        End If
        
        msg = msg & vbCrLf      ' Cледующий
    Next
        
    'Информация Блока Отображения для этого рисунка
    MsgBox "Блоки в этом рисунке имеют следующие стили: " & msg

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