HasAttributes Пример |
Sub Example_HasAttributes() ' Этот пример сначала создает блок без атрибутов. ' Затем вставляет блок и проверяет, имеет ли он атрибуты. ' Затем добавляет атрибуты к блоку и вставляет его снова. ' Проверяет новое вхождение блока для атрибутов. ' Создайте блок Dim blockObj As AcadBlock Dim insertionPnt(0 To 2) As Double insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0# Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock") ' Добавьте круг к блоку Dim circleObj As AcadCircle Dim center(0 To 2) As Double Dim radius As Double center(0) = 0: center(1) = 0: center(2) = 0 radius = 1 Set circleObj = blockObj.AddCircle(center, radius) ' Вставьте блок Dim blockRefObj As AcadBlockReference insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0 Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0) ThisDrawing.Application.ZoomAll MsgBox "Это вхождение блока " & IIf(blockRefObj.HasAttributes, "имеет атрибуты.", "не имеет атрибутов."), , "Has Attributes Пример" ' Добавьте атрибуты к выделению блока. ' Определите определение атрибута. Dim attributeObj As AcadAttribute Dim height As Double Dim mode As Long Dim prompt As String Dim insertionPoint(0 To 2) As Double Dim tag As String Dim value As String height = 1# mode = acAttributeModeVerify prompt = "Attribute Prompt" insertionPoint(0) = 1#: insertionPoint(1) = 1#: insertionPoint(2) = 0 tag = "Attribute Tag" value = "Attribute Value" ' Создайте определение атрибута Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value) ' Вставьте блок снова Dim blockRefObj2 As AcadBlockReference insertionPnt(0) = 3#: insertionPnt(1) = 3#: insertionPnt(2) = 0 Set blockRefObj2 = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0) ZoomAll MsgBox "Первое вхождение блока " & IIf(blockRefObj.HasAttributes, "имеет атрибуты.", "не имеет атрибутов.") & vbCrLf & _ "Второе вхождение блока " & IIf(blockRefObj2.HasAttributes, "имеет атрибуты.", "не имеет атрибутов."), , "Has Attributes Пример" End Sub