Тема: SendCommand для динамической вставки блоков + обработка
Для юзверей очень нужно было отображать вставку блоков динамически, как из самого автокада. Методом InsertBlock добиться отображения при вставке не получилось никак :(
А с SendCommand'ом творились просто ужасные вещи. Проект уже к атрибутам обращается, а блок еще не вставлен и т.п. ...
В итоге функция получилась корявая, но она РАБОТАЕТ и при этом возвращает AcadBlockReference )))
Теперь очень бы хотелось узнать, как грамотно выйти из функции по нажатию “Esc”.)
И как можно оптимизировать процесс?
Function DrawBlockRef(entBlock As AcadBlock) As AcadBlockReference
With ThisDrawing
[i]' рисуем вхождение блока
' методом посыла строковых команд прямо в автокад,
' т.к. в этом случае вхождение блока отображается динамически на экране
'перед этим вставим в пространство модели "контрольную точку"
'для обхода сбоев в работе SendCommand [/i]
Dim tPoint As AcadPoint
Dim ip(2) As Double
ip(0) = 0: ip(1) = 0: ip(2) = 0
Set tPoint = .ModelSpace.AddPoint(ip)
[i]'теперь рисуем сам блок при помощи SendCommand[/i]
LetsDoItAgain:
ThisDrawing.SendCommand _
"-i" & vbCr & _
entBlock.Name & vbCr & _
"S" & vbCr & _
1 & vbCr & _
"R" & vbCr & _
"0" & vbCr
[i]'проверяем выполнение процедуры SendCommand
'Если блок еще не вставлен, то отправляем команды снова
'Если блок вставлен - удаляем "контрольную точку" и идем дальше[/i]
If .ModelSpace(.ModelSpace.Count - 1).ObjectName = "AcDbPoint" Then
GoTo LetsDoItAgain
Else
.ModelSpace(.ModelSpace.Count - 2).Delete
End If
Update
[i]'запишем вхождение блока, которое сейчас вставили
'в переменную для возврата функции[/i]
Dim tblref As AcadBlockReference
Set tblref = .ModelSpace(.ModelSpace.Count - 1)
[i]'возвращаем значение[/i]
Set DrawBlockRef = tblref
End With
End Function
