Как создать блок из круга? (Страница 1 из 2)

'Вставка блока с атрибутом
'Пример вставки в чертеж высотной отметки
Sub InsertBlockAtr()
Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim tag As String
Dim value As String
Dim prompt As String
Dim insPoint(0 To 2) As Double
'Создание блока
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 55#: insertionPnt(1) = -11.5: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "Otmetka")
'Создание Атрибута в блоке
height = 7.5
mode = acAttributeModeVerify
prompt = "Отметка"
insPoint(0) = -50#: insPoint(1) = 17#: insPoint(2) = 0
tag = "0.000"
value = "0.000"
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insPoint, tag, value)
'Создание Полилинии в блоке
Dim plineObj As AcadLWPolyline
Dim points(0 To 13) As Double
points(0) = 4: points(1) = -5.5
points(2) = 0.5: points(3) = -5.5
points(4) = 4: points(5) = -11.5
points(6) = 7.5: points(7) = -5.5
points(8) = 4: points(9) = -5.5
points(10) = 4: points(11) = 3.5
points(12) = 40: points(13) = 3.5
Set plineObj = blockObj.AddLightWeightPolyline(points)
'Создание линии в блоке
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 0.5: startPoint(1) = -11.5: startPoint(2) = 0#
endPoint(0) = 55#: endPoint(1) = -11.5: endPoint(2) = 0#
Set lineObj = blockObj.AddLine(startPoint, endPoint)
'Вставка блока в чертеж
Dim blockRefObj As AcadBlockReference
Dim InsertPnt As Variant
InsertPnt = ThisDrawing.Utility.GetPoint _
(, vbCrLf & "Укажите точку вставки:")
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
(InsertPnt, "Otmetka", 1#, 1#, 1#, 0)
attributeObj.Delete
End Sub