27/07/2013
Переименование или копирование анонимного блока с использованием LISP или VBA
Вопрос: как можно анонимному блоку задать другое имя, например, TestBlock?
Ответ: задать имя анонимному блоку возможно. Например, можно переименовать анонимный блок со служебным именем *T1 в TestBlock. Во время вызова команды _.insert или _.block в списке доступных блоков имя TestBlock не показывается, хотя блок с таким именем и существует. Изменение имени анонимного блока не приведет к изменению анонимного блока в нормальный: DXF-группа 70 определяет, является блок анонимным или нет, и не подлежит редактированию.
Например, создадим анонимный блок с маской имени *T, используя команду any_blk, и затем выполним команду ren_blk (переименуем блок в TestBlock):
Код - Auto/Visual LISP: [Выделить]
(defun c:any_blk ()
(vl-load-com)
(setq a_app (vlax-get-acad-object)
a_doc (vla-get-activedocument a_app)
a_blks (vla-get-blocks a_doc)
blk (vla-add a_blks (vlax-3d-point '(0 0 0)) "*T")
) ;_ end of setq
(vla-addcircle blk (vlax-3d-point '(0 0 0)) 3)
) ;_ end of defun
(defun c:ren_blk ()
(vl-load-com)
(setq a_app (vlax-get-acad-object)
a_doc (vla-get-activedocument a_app)
a_blks (vla-get-blocks a_doc)
blk (vla-item a_blks "*T1")
) ;_ end of setq
(vla-put-name blk "TestBlock")
) ;_ end of defun
Теперь выполним команду _.insert и увидим, что TestBlock не показывается в списке доступных для вставки блоков. Тем не менее, можно ввести имя блока и потом вставить его. Блок с именем TestBlock не показывается в списке, т.к. он фактически является анонимным блоком.
Как еще один вариант, можно выполнить полную копию содержимого анонимного блока вместо его переименования – так, как показано в следующем коде:
Код - Auto/Visual LISP: [Выделить]
(defun c:cop_blk ()
(vl-load-com)
(setq a_app (vlax-get-acad-object)
a_doc (vla-get-activedocument a_app)
a_blks (vla-get-blocks a_doc)
i 0
) ;_ end of setq
(if (tblsearch "BLOCK" "*T2")
(progn
(setq blk (vla-item a_blks "*T2"))
(setq inspt (vla-get-origin blk)
cnt (- (vla-get-count blk) 1)
newfil (vlax-make-safearray vlax-vbobject (cons 0 cnt))
) ;_ end of setq
(vlax-for ent blk
(vlax-safearray-put-element newfil i ent)
(setq i (1+ i))
) ;_ end of vlax-for
(if (null (tblsearch "BLOCK" "TESTBLOCK"))
(setq newblk (vla-add a_blks inspt "TESTBLOCK"))
(setq newblk (vla-add a_blks inspt "TESTBLOCKX"))
) ;_ end of if
(vla-copyobjects a_doc newfil newblk nil)
) ;_ end of progn
(princ "\nБлок *T недоступен. Невозможно сделать копию.")
) ;_ end of if
(princ)
) ;_ end of defun
А вот код VBA для копирования содержимого анонимного блока:
Код - VBA: [Выделить]
Sub copyblk()
Dim objects() As Object
Dim oldblk As AcadBlock
Dim newblk As AcadBlock
Dim inspt As Variant
Dim obj As Object
Dim i As Integer
i = 0
' Замените "*T1" на соотвествуещее имя анонимного блока
Set oldblk = ThisDrawing.Blocks.Item("*T1")
inspt = oldblk.Origin
Cnt = oldblk.Count - 1
ReDim objects(Cnt) As Object
For Each obj In oldblk
Set objects(i) = obj
i = i + 1
Next obj
Set newblk = ThisDrawing.Blocks.Add(inspt, "NEWTEST")
ThisDrawing.CopyObjects objects, newblk
End Sub
Примечания переводчика:
1. Настоятельно не рекомендуется для создания анонимных блоков использовать шаблоны имен, отличающиеся от *U: например, показанный *T используется внутри AutoCAD для определения вхождений объектов таблиц.
2. В коде функция (vl-load-com) вводится в каждой команде, не определены локальные переменные, что, с моей точки зрения, значительно снижает ценность кода.
3. Любая попытка переименования анонимного блока обречена на провал, корректно будет работать только вариант с копированием содержимого.
Исходя из вышесказанного, мне кажется более приемлемым следующий вариант создания и «переименования» анонимного блока (без замены вхождений):
Код - Auto/Visual LISP: [Выделить]
(vl-load-com)
(defun c:anonym-create (/ adoc blk)
;|
* Create and fill anonymous block definition
* Создание и заполнение определения анонимного блока
|;
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(setq blk (vla-add (vla-get-blocks adoc)
(vlax-3d-point '(0. 0. 0.))
"*U"
) ;_ end of vla-add
) ;_ end of setq
(vla-addcircle blk (vlax-3d-point '(0. 0. 0.)) 3.)
;; Forced block insertion to predefined point at ModelSpace
;; Принудительная вставка блока в строго определенную точку пространства модели
(vla-insertblock (vla-get-modelspace adoc)
(vlax-3d-point '(10. 10. 0.))
(vla-get-name blk)
1.
1.
1.
0.
) ;_ end of vla-InsertBlock
(vla-endundomark adoc)
(princ)
) ;_ end of defun
(defun c:anonym-copy (/ adoc blk_ref name blk_ref_cont blk)
;|
* Copying anonymous block definition to a "normal" block
* Копирование состава указанного анонимного блока в нормальный
|;
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(if (and (= (type (setq blk_ref (car (entsel "\nSelect anonymous block reference : ")))) 'ename)
(= (cdr (assoc 0 (entget blk_ref))) "INSERT")
) ;_ end of and
(progn
(setq blk_ref (vla-item (vla-get-blocks adoc) (cdr (assoc 2 (entget blk_ref))))
name "TestBlock"
blk (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) name)
) ;_ end of setq
(vlax-for ent blk_ref
(setq blk_ref_cont (cons ent blk_ref_cont))
) ;_ end of vlax-for
(setq blk_ref_cont (reverse blk_ref_cont))
(vla-copyobjects adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length blk_ref_cont)))
) ;_ end of vlax-make-safearray
blk_ref_cont
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
blk
) ;_ end of vla-CopyObjects
) ;_ end of progn
) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defun
Перевел: Кулик Алексей
Источник: http://adndevblog.typepad.com/autocad/2013/01/renaming-or-copying-an-anonymous-block-using-lisp-or-vba.html
Обсуждение: http://adn-cis.org/forum/index.php?topic=35.0
Опубликовано 27.07.2013
Отредактировано 27.10.2013 в 00:05:15
