Sub AddAttributePritok()
Dim blk As AcadBlockReference
Dim att As AcadAttribute
Dim insertionPoint(0 To 2) As Double
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim tag As String
Dim value As String
' Удалить существующий Selection Set, если он есть
On Error Resume Next
ThisDrawing.SelectionSets.Item("SelectionSet").Delete
On Error GoTo 0
' Создать новый Selection Set
Dim selectionSet As AcadSelectionSet
Set selectionSet = ThisDrawing.SelectionSets.Add("SelectionSet")
' Проверить, удалось ли создать Selection Set
If Not selectionSet Is Nothing Then
' Предоставить пользователю возможность выбрать объекты
selectionSet.SelectOnScreen
' Перебрать все выбранные объекты
For Each obj In selectionSet
' Проверить, является ли объект блоком
If TypeOf obj Is AcadBlockReference Then
Set blk = obj
' Задать параметры атрибута
height = 1#
mode = acAttributeModeInvisible
prompt = "тест"
insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
tag = "тест"
value = "привет"
' Создать новый атрибут
Set att = blk.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
' Обработать ситуацию, если добавление атрибута не удалось
If Not att Is Nothing Then
MsgBox "Атрибут успешно добавлен к блоку."
Else
MsgBox "Ошибка при добавлении атрибута к блоку.", vbExclamation
End If
End If
Next obj
' Удалить Selection Set после использования
selectionSet.Delete
End If
End Sub