|
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