Как добавить в набор только блоки?

> Александр Ривилис
Если как он говорит что блоки с атрибутами, то
лучше использовать такой фильтр:

Dim intType(0 to 1) As Integer
Dim varData(0 to 1) As Variant
intType(0) = 0
varData(0) = "INSERT"
intType(1) = 66
varData(1) = 1

Если выбор блоков по имени, тогда добавить
в фильтр:

Dim intType(0 to 2) As Integer
Dim varData(0 to 2) As Variant
intType(0) = 0
varData(0) = "INSERT"
intType(1) = 2
varData(1) = "Штамп"
intType(2) = 66
varData(2) = 1

Правда, тут код (66 . 1) можно и опустить, поскольку и так знаешь
что в штампе у тебя атрибуты
Следующий кусок вообще не нужен, фильтр выбирает только
блоки с атрибутами, поэтому излишняя проверка
не нужна:

For Each elem In objSelSet
    If elem.EntityName = "AcDbBlockReference" Then

Лучше сразу так (причем переменная ведь elem уже задана ранее
уже как AcadApplication:

Set elem = ACADApp

причем здесь блоки???)
Задавай так:

Dim ent as AcadEntity

или неявно:

Dim ent as Object

Тогда код должен выглядеть так:

Dim blk as AcadBlockReference
For Each ent In objSelSet
Set blk=ent
dim atts as variant
atts=blk.GetAttributes
Dim i as integer
Dim attobj as AcadAttributeReference
For LBound(atts) to UBound(atts)
Set attobj=atts(i)
...
и тд
Next
Next

~'J'~

> Fatty
Н-да... У кого это мысли сходятся?

Помогите пожалуйста отредактировать программный код.
Мне надо создать блок из круга с диаметром 2,25.
Чтобы его имя складывалось из элементов моей формы.
ИМЯ БЛОКА = Label, TextBox1, TextBox2,TextBox3.
Никак не получается. Как создавать блоки???
Я нашел только этот пример...
'Вставка блока с атрибутом
'Пример вставки в чертеж высотной отметки
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