ADN Open CIS
Сообщество программистов Autodesk в СНГ

27/07/2013

Переименование или копирование анонимного блока с использованием LISP или VBA

Вопрос: как можно анонимному блоку задать другое имя, например, TestBlock?

Ответ: задать имя анонимному блоку возможно. Например, можно переименовать анонимный блок со служебным именем *T1 в TestBlock. Во время вызова команды _.insert или _.block в списке доступных блоков имя TestBlock не показывается, хотя блок с таким именем и существует. Изменение имени анонимного блока не приведет к изменению анонимного блока в нормальный: DXF-группа 70 определяет, является блок анонимным или нет, и не подлежит редактированию.

Например, создадим анонимный блок с маской имени *T, используя команду any_blk, и затем выполним команду ren_blk (переименуем блок в TestBlock):

Код - Auto/Visual LISP: [Выделить]
  1. (defun c:any_blk ()
  2.   (vl-load-com)
  3.   (setq a_app  (vlax-get-acad-object)
  4.         a_doc  (vla-get-activedocument a_app)
  5.         a_blks (vla-get-blocks a_doc)
  6.         blk    (vla-add a_blks (vlax-3d-point '(0 0 0)) "*T")
  7.         ) ;_ end of setq
  8.   (vla-addcircle blk (vlax-3d-point '(0 0 0)) 3)
  9.   ) ;_ end of defun
  10.  
  11. (defun c:ren_blk ()
  12.   (vl-load-com)
  13.   (setq a_app  (vlax-get-acad-object)
  14.         a_doc  (vla-get-activedocument a_app)
  15.         a_blks (vla-get-blocks a_doc)
  16.         blk    (vla-item a_blks "*T1")
  17.         ) ;_ end of setq
  18.   (vla-put-name blk "TestBlock")
  19.   ) ;_ end of defun


Теперь выполним команду _.insert и увидим, что TestBlock не показывается в списке доступных для вставки блоков. Тем не менее, можно ввести имя блока и потом вставить его.  Блок с именем TestBlock не показывается в списке, т.к. он фактически является анонимным блоком.

Как еще один вариант, можно выполнить полную копию содержимого анонимного блока вместо его переименования – так, как показано в следующем коде:

Код - Auto/Visual LISP: [Выделить]
  1. (defun c:cop_blk ()
  2.   (vl-load-com)
  3.   (setq a_app  (vlax-get-acad-object)
  4.         a_doc  (vla-get-activedocument a_app)
  5.         a_blks (vla-get-blocks a_doc)
  6.         i      0
  7.         ) ;_ end of setq
  8.   (if (tblsearch "BLOCK" "*T2")
  9.     (progn
  10.       (setq blk (vla-item a_blks "*T2"))
  11.       (setq inspt  (vla-get-origin blk)
  12.             cnt    (- (vla-get-count blk) 1)
  13.             newfil (vlax-make-safearray vlax-vbobject (cons 0 cnt))
  14.             ) ;_ end of setq
  15.       (vlax-for ent blk
  16.         (vlax-safearray-put-element newfil i ent)
  17.         (setq i (1+ i))
  18.         ) ;_ end of vlax-for
  19.       (if (null (tblsearch "BLOCK" "TESTBLOCK"))
  20.         (setq newblk (vla-add a_blks inspt "TESTBLOCK"))
  21.         (setq newblk (vla-add a_blks inspt "TESTBLOCKX"))
  22.         ) ;_ end of if
  23.       (vla-copyobjects a_doc newfil newblk nil)
  24.       ) ;_ end of progn
  25.     (princ "\nБлок *T недоступен. Невозможно сделать копию.")
  26.     ) ;_ end of if
  27.   (princ)
  28.   ) ;_ end of defun


А вот код VBA для копирования содержимого анонимного блока:


Код - VBA: [Выделить]
  1. Sub copyblk()
  2.    Dim objects() As Object
  3.    Dim oldblk As AcadBlock
  4.    Dim newblk As AcadBlock
  5.    Dim inspt As Variant
  6.    Dim obj As Object
  7.    Dim i As Integer
  8.    i = 0
  9. ' Замените "*T1" на соотвествуещее имя анонимного блока
  10.    Set oldblk = ThisDrawing.Blocks.Item("*T1")
  11.    inspt = oldblk.Origin
  12.    Cnt = oldblk.Count - 1
  13.    ReDim objects(Cnt) As Object
  14.   
  15.    For Each obj In oldblk
  16.     Set objects(i) = obj
  17.     i = i + 1
  18.    Next obj
  19.   
  20.    Set newblk = ThisDrawing.Blocks.Add(inspt, "NEWTEST")
  21.    ThisDrawing.CopyObjects objects, newblk
  22. End Sub



Примечания переводчика:

1.       Настоятельно не рекомендуется для создания анонимных блоков использовать шаблоны имен, отличающиеся от *U: например, показанный *T используется внутри AutoCAD для определения вхождений объектов таблиц.

2.       В коде функция (vl-load-com) вводится в каждой команде, не определены локальные переменные, что, с моей точки зрения, значительно снижает ценность кода.

3.       Любая попытка переименования анонимного блока обречена на провал, корректно будет работать только вариант с копированием содержимого.

Исходя из вышесказанного, мне кажется более приемлемым следующий вариант создания и «переименования» анонимного блока (без замены вхождений):

Код - Auto/Visual LISP: [Выделить]
  1. (vl-load-com)
  2. (defun c:anonym-create (/ adoc blk)
  3.                        ;|
  4. *    Create and fill anonymous block definition
  5. *    Создание и заполнение определения анонимного блока
  6.  
  7. |;
  8.   (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  9.   (setq blk (vla-add (vla-get-blocks adoc)
  10.                      (vlax-3d-point '(0. 0. 0.))
  11.                      "*U"
  12.                      ) ;_ end of vla-add
  13.         ) ;_ end of setq
  14.   (vla-addcircle blk (vlax-3d-point '(0. 0. 0.)) 3.)
  15.   ;; Forced block insertion to predefined point at ModelSpace
  16.   ;; Принудительная вставка блока в строго определенную точку пространства модели
  17.   (vla-insertblock (vla-get-modelspace adoc)
  18.                    (vlax-3d-point '(10. 10. 0.))
  19.                    (vla-get-name blk)
  20.                    1.
  21.                    1.
  22.                    1.
  23.                    0.
  24.                    ) ;_ end of vla-InsertBlock
  25.   (vla-endundomark adoc)
  26.   (princ)
  27.   ) ;_ end of defun
  28.  
  29. (defun c:anonym-copy (/ adoc blk_ref name blk_ref_cont blk)
  30.                      ;|
  31. *    Copying anonymous block definition to a "normal" block
  32. *    Копирование состава указанного анонимного блока в нормальный
  33. |;
  34.   (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  35.   (if (and (= (type (setq blk_ref (car (entsel "\nSelect anonymous block reference : ")))) 'ename)
  36.            (= (cdr (assoc 0 (entget blk_ref))) "INSERT")
  37.            ) ;_ end of and
  38.     (progn
  39.       (setq blk_ref (vla-item (vla-get-blocks adoc) (cdr (assoc 2 (entget blk_ref))))
  40.             name    "TestBlock"
  41.             blk     (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) name)
  42.             ) ;_ end of setq
  43.       (vlax-for ent blk_ref
  44.         (setq blk_ref_cont (cons ent blk_ref_cont))
  45.         ) ;_ end of vlax-for
  46.       (setq blk_ref_cont (reverse blk_ref_cont))
  47.       (vla-copyobjects adoc
  48.                        (vlax-make-variant
  49.                          (vlax-safearray-fill
  50.                            (vlax-make-safearray
  51.                              vlax-vbobject
  52.                              (cons 0 (1- (length blk_ref_cont)))
  53.                              ) ;_ end of vlax-make-safearray
  54.                            blk_ref_cont
  55.                            ) ;_ end of vlax-safearray-fill
  56.                          ) ;_ end of vlax-make-variant
  57.                        blk
  58.                        ) ;_ end of vla-CopyObjects
  59.       ) ;_ end of progn
  60.     ) ;_ end of if
  61.   (vla-endundomark adoc)
  62.   (princ)
  63.   ) ;_ 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