Комментарии

1. Кулик Алексей aka kpblc пишет:

   24 Февраль 2010 в 0:25

   В случае, если надо обрабатывать только выделяемые блоки, но с учетом вложенных, код становится чуть посложнее.
   [cc lang="cadlisp"](vl-load-com)

   ;; Вызов: (lispru-change-block-units-by-select-with-subblocks)
   (defun lispru-change-block-units-by-select-with-subblocks
   (/ _dwgru-conv-pickset-to-list adoc selset blk_list name)

   ;|
   * Преобразование единиц измерения блоков, включая вложенные блоки
   |;

   (defun fun_get-name (ent)
   ;; Получение имени блока
   (cond
   ((vlax-property-available-p ent 'effectivename)
   (vla-get-effectivename ent)
   )
   ((vlax-property-available-p ent 'name)
   (vla-get-name ent)
   )
   ) ;_ end of cond
   ) ;_ end of defun

   (defun _dwgru-conv-pickset-to-list (value / tab item)
   ;;; http://forum.dwg.ru/showpost.php?p=188342&postcount=21
   (repeat (setq tab nil
   item (sslength value)
   ) ;_ end setq
   (setq tab (cons (ssname value (setq item (1- item))) tab))
   ) ;_ end repeat
   ) ;_ end defun

   ;; Поставим метку начала отмены. Ну так, на всякий случай
   (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
   ;; Получаем набор блоков, обрабатывая нажатие Esc
   (if (= (type (setq selset (vl-catch-all-apply
   (function
   (lambda ()
   (ssget '((0 . "INSERT")))
   ) ;_ end of lambda
   ) ;_ end of function
   ) ;_ end of vl-catch-all-apply
   ) ;_ end of setq
   ) ;_ end of type
   'pickset
   ) ;_ end of =
   (progn
   ;; Сформируем список имен блоков, исключая дубликаты
   ;; И не забываем про вложенные блоки
   (foreach ent
   ;; Преобразовываем набор в список элементов, исключая внешние ссылки.
   ((lambda (/ item lst)
   (foreach item
   (apply
   (function append)
   (mapcar
   (function
   (lambda (x / res)
   ;; применяем эту функцию
   (setq res (list x))
   (vlax-for item x
   (if
   (wcmatch
   (strcase
   (vla-get-objectname item)
   ) ;_ end of strcase
   "*BLOCK*"
   ) ;_ end of wcmatch
   (setq res (cons item res))
   ) ;_ end of if
   ) ;_ end of vlax-for
   res
   ) ;_ end of lambda
   ) ;_ end of function
   ;; begin : удаление внешних ссылок
   (vl-remove-if
   (function
   (lambda (x)
   (equal
   (vla-get-isxref
   (vla-get-name x)
   ) ;_ end of vla-get-isxref
   :vlax-true
   ) ;_ end of equal
   ) ;_ end of lambda
   ) ;_ end of function
   (mapcar
   (function
   (lambda (x)
   (vla-item
   (vla-get-blocks adoc)
   (fun_get-name
   (vlax-ename->vla-object x)
   ) ;_ end of fun_get-name
   ) ;_ end of vla-item
   ) ;_ end of lambda
   ) ;_ end of function
   (_dwgru-conv-pickset-to-list selset)
   ) ;_ end of mapcar
   ) ;_ end of vl-remove-if
   ;; end : удаление внешних ссылок
   ) ;_ end of mapcar
   ) ;_ end of apply
   (if (not (member (fun_get-name item)) lst)
   (setq lst (cons item lst))
   ) ;_ end of if
   ) ;_ end of foreach
   lst
   ) ;_ end of lambda
   ) ;_ end of foreach
   (if (not (member (setq name (fun_get-name ent)) blk_list))
   (setq blk_list (cons name blk_list))
   ) ;_ end of if
   ) ;_ end of foreach
   ;; Запускаем новый цикл
   (foreach blk_def
   ;; Из списка имен получаем список указателей на описания блоков
   (mapcar
   (function
   (lambda (x)
   (vla-item (vla-get-blocks adoc) x)
   ) ;_ end of lambda
   ) ;_ end of function
   blk_list
   ) ;_ end of mapcar
   (vl-catch-all-apply
   (function
   (lambda ()
   (vla-put-units blk_def 0)
   ) ;_ end of lambda
   ) ;_ end of function
   ) ;_ end of vl-catch-all-apply
   ) ;_ end of foreach
   ) ;_ end of progn
   ) ;_ end of if
   ;; Теперь метка конца отмены
   (vla-endundomark adoc)
   ;; Ну и "тихий" выход
   (princ)
   ) ;_ end of defun[/cc]
   Код не комментирую (хотя по-хорошему надо бы, я там немного логику поменял). Надо будет - обращайтесь
2. ganjour пишет:

   6 Июль 2020 в 2:42

   Спасибо. Код пригодился для нормализации блоков геодезических условных знаков.