| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Редактирование имен слоев после внедрения внешних ссылок. Не все слои обрабатывает.

Lisp. Редактирование имен слоев после внедрения внешних ссылок. Не все слои обрабатывает.

Ответ
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 13.09.2022, 14:25 #1
Lisp. Редактирование имен слоев после внедрения внешних ссылок. Не все слои обрабатывает.
Composter
 
Отопление и вентиляция
 
Москва
Регистрация: 31.10.2008
Сообщений: 445
Добрый день. Написал лисп чтобы чистил имена слоев, после внедрения внешних ссылок. Т.е. он обрезает левую часть именя слоя где есть $0$, если слоя слоя с новым именем нет то созадет, если есть то все элементы со старого слоя переносит в новый. Но загвоздка в том что лисп обрабатывает не все слои, несколько слоев остаётся. Подскажите что я длаю не так
Код:
[Выделить все] 
 (defun Zd131 (  / newnamelayer  posit_1 poisk_simv layer_name02 usercmd  ss1 ent)
(princ "\n Убирает в названиях слоев все слева до символов $0$")
(defun subst_ent_lay ( ent str01 / ent_lay)
	(setq ent_lay (cdr (assoc 8 (entget ent))))
	(cons 8 (substr ent_lay (+ 4 (vl-string-search str01 ent_lay))))
)
(defun subst_vla_object_lay ( vla_object01 str01 / )
	(substr (vla-get-Layer vla_object01) (+ 4 (vl-string-search str01 (vla-get-Layer vla_object01))))
)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "regenmode" 0)
(layerstate-save "Zd131" nil nil)
(VL-CMDF "-layer" "_Unlock" "*" "")
(setq poisk_simv "$0$" )
(vlax-for layer_name01 (vla-get-layers(vla-get-activedocument(vlax-get-acad-object)))
	(if	(setq posit_1(vl-string-search poisk_simv (vla-get-name layer_name01)))
		(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-item(list (vla-get-layers(vla-get-activedocument(vlax-get-acad-object))) (setq layer_name02(substr (vla-get-name layer_name01) (+ 4 posit_1))))))
			(vl-catch-all-apply 'vla-put-Name(list layer_name01 layer_name02))
			(setq ss1 (append ss1 (list (vla-get-name layer_name01))))
		)
	)
);_end_of_vlax-for
(if (null ss1) (exit))
(setq ent (entnext))
(while ent
	(if (member  (assoc 8 (entget ent))  ss1)
		(entmod		
			(subst 	(subst_ent_lay ent poisk_simv)
					(assoc 8 (entget ent))
					(entget ent)
			)
		)
	)
	(setq ent (entnext ent))
)
(vlax-for block_name (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
	(vlax-for vlog_block_name block_name
		(if (vlax-property-available-p vlog_block_name 'Layer)
			(if
				(member  (vla-get-Layer vlog_block_name) ss1)
				(vla-put-Layer vlog_block_name (subst_vla_object_lay vlog_block_name poisk_simv))
			)
		);_end_of_if
	);_end_of_vlax-for
	(if (vlax-property-available-p block_name 'Layer)
			(if
				(member  (vla-get-Layer block_name) ss1)
				(vla-put-Layer block_name (subst_vla_object_lay block_name poisk_simv))
			)
	)
)
(layerstate-restore "Zd131" )
(setvar "CMDECHO" usercmd)
(setvar "regenmode" 1)
(princ)
)
(defun C:Zd131()(Zd131))
Просмотров: 2959
 
Непрочитано 13.09.2022, 15:10
#2
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 470

Для начала поставь в конец программы сообщение об успешном завершении,
чтобы понимать, что случилось - или вылетела "по ошибке" или недодуман
алгоритм работы.
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Автор темы   Непрочитано 13.09.2022, 16:00
#3
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

зачем? если ошибка , то и так автокад все напишет
Composter вне форума  
 
Непрочитано 13.09.2022, 16:53
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Подозреваю, что такие имена уже просто есть в чертеже.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 13.09.2022, 17:03
#5
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

я уже вроде писал что либо просто обрезает имя слоя, если уже есть такой слой (с обрезанным именем), то все примитивы из необрезанного слоя перекидывает в обрезанный.

мне хотя бы понять как перебрать все примитивы в чертеже и поменять им слой?
метод один
Код:
[Выделить все] 
 (setq ent (entnext))
(while ent
......
	(setq ent (entnext ent))
)
метод два
Код:
[Выделить все] 
 (vlax-for block_name (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
	(vlax-for vlog_block_name block_name
.......
	)
)
может эти 2 метода не захватывают какие то элементы?
Composter вне форума  
 
Непрочитано 13.09.2022, 17:27
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Имена слоев (или указатели на них) еще могут болтаться в расширенных данных, в словарях, в DXF-описаниях окончаний блоков и бог знает где еще.

----- добавлено через ~2 мин. -----
Я бы подумал на предмет использования _.-laymrg
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 13.09.2022, 18:09
#7
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Я бы подумал на предмет использования _.-laymrg
это была предыдущая версия
Код:
[Выделить все] 
 (defun Zd131 (  / newnamelayer  posit_1 poisk_simv layer_name02 flag01 usercmd)
(princ "\n Убирает в названиях слоев все слева до символов $0$")
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "regenmode" 0)
(setq poisk_simv "$0$" )
(vlax-for layer_name01 (vla-get-layers(vla-get-activedocument(vlax-get-acad-object)))
	(if	(setq posit_1(vl-string-search poisk_simv (vla-get-name layer_name01)))
		(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-item(list (vla-get-layers(vla-get-activedocument(vlax-get-acad-object))) (setq layer_name02(substr (vla-get-name layer_name01) (+ 4 posit_1))))))
			(vl-catch-all-apply 'vla-put-Name(list layer_name01 layer_name02))
			(VL-CMDF "_.-LAYMRG" "_Name"(vla-get-name layer_name01)"" "_Name" layer_name02 "_Yes")
		)
	)
);_end_of_vlax-for
(setvar "CMDECHO" usercmd)
(setvar "regenmode" 1)
(princ)
)
Успешно использовал. Но вчера наткнулся на файл, что при попытке мёрджить (даже в ручную и по одному слою) некоторые слои посылали нафиг и выдавали fatal error . Поэтому я пошел другим путем
Последний раз редактировалось Composter, 13.09.2022 в 18:22.
Composter вне форума  
 
Непрочитано 13.09.2022, 21:08
#8
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Гоняй, проверяй
Код:
[Выделить все] 
 (vl-load-com)

(defun c:remove$ (/ _kpblc-conv-vla-to-list _kpblc-block-attr-get-pointer-mask adoc layer_status search_sym new_layer
                 )

  (defun _kpblc-conv-vla-to-list (value / res)
    (cond ((listp value) (mapcar (function _kpblc-conv-vla-to-list) value))
          ((= (type value) 'variant) (_kpblc-conv-vla-to-list (vlax-variant-value value)))
          ((= (type value) 'safearray)
           (if (>= (vlax-safearray-get-u-bound value 1) 0)
             (_kpblc-conv-vla-to-list (vlax-safearray->list value))
           ) ;_ end of if
          )
          ((and (= (type value) 'vla-object)
                (vlax-property-available-p value 'count)
           ) ;_ end of and
           (vlax-for sub value (setq res (cons sub res)))
          )
          (t value)
    ) ;_ end of cond
  ) ;_ end of defun

  (defun _kpblc-block-attr-get-pointer-mask (blk mask / res)
    (setq res (apply (function append)
                     (mapcar (function (lambda (x)
                                         (if (vlax-method-applicable-p blk x)
                                           (_kpblc-conv-vla-to-list (vlax-invoke-method blk x))
                                         ) ;_ end of if
                                       ) ;_ end of lambda
                             ) ;_ end of function
                             '("getattributes" "getconstantattributes")
                     ) ;_ end of mapcar
              ) ;_ end of apply
    ) ;_ end of setq
    (if (or (not mask) (= mask "*"))
      res
      (vl-remove-if-not
        (function (lambda (x) (wcmatch (strcase (vla-get-tagstring x)) (strcase mask))))
        res
      ) ;_ end of vl-remove-if-not
    ) ;_ end of if
  ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for item (vla-get-layers adoc)
    (setq layer_status
           (cons (cons
                   item
                   (mapcar (function (lambda (prop / temp)
                                       (setq temp (vlax-get-property item prop))
                                       (vl-catch-all-apply (function (lambda () (vlax-put-property item prop :vlax-false))))
                                       (cons prop temp)
                                     ) ;_ end of lambda
                           ) ;_ end of function
                           '("freeze" "lock")
                   ) ;_ end of mapcar
                 ) ;_ end of cons
                 layer_status
           ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of vlax-for

  (setq search_sym "$0$")

  (vlax-for blk_def (vla-get-blocks adoc)
    (vlax-for ent blk_def
      (cond
        ((wcmatch (vla-get-objectname ent) "AcDbAttr*Def*")
         (vla-put-layer ent "0")
        )
        ((wcmatch (vla-get-layer ent) (strcat "*" search_sym "*"))
         (setq new_layer (vla-add (vla-get-layers adoc)
                                  (substr (vla-get-layer ent)
                                          (+ 1 (strlen search_sym) (vl-string-search search_sym (vla-get-layer ent)))
                                  ) ;_ end of substr
                         ) ;_ end of vla-add
         ) ;_ end of setq
         (vla-put-layer ent (vla-get-name new_layer))
         (if (wcmatch (vla-get-objectname ent) "AcDbBlockRef*")
           (foreach att (_kpblc-block-attr-get-pointer-mask ent nil)
             (vla-put-layer att (vla-get-name new_layer))
           ) ;_ end of foreach
         ) ;_ end of if
        )
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for

  (foreach item layer_status
    (if (not (vlax-object-released-p (car item)))
      (foreach prop (cdr item)
        (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car prop) (cdr prop)))))
      ) ;_ end of foreach
    ) ;_ end of if
  ) ;_ end of foreach

  (vla-auditinfo adoc :vlax-true)
  (repeat 3 (vla-purgeall adoc))

  (vla-endundomark adoc)
  (princ)
) ;_ end of defun
И чуть более универсальный вариант
Код:
[Выделить все] 
 (vl-load-com)

(defun c:remove$2 (/ _kpblc-conv-vla-to-list _kpblc-block-attr-get-pointer-mask adoc layer_status search_sym new_layer name
                  )

  (defun _kpblc-conv-vla-to-list (value / res)
    (cond ((listp value) (mapcar (function _kpblc-conv-vla-to-list) value))
          ((= (type value) 'variant) (_kpblc-conv-vla-to-list (vlax-variant-value value)))
          ((= (type value) 'safearray)
           (if (>= (vlax-safearray-get-u-bound value 1) 0)
             (_kpblc-conv-vla-to-list (vlax-safearray->list value))
           ) ;_ end of if
          )
          ((and (= (type value) 'vla-object)
                (vlax-property-available-p value 'count)
           ) ;_ end of and
           (vlax-for sub value (setq res (cons sub res)))
          )
          (t value)
    ) ;_ end of cond
  ) ;_ end of defun


  (defun _kpblc-block-attr-get-pointer-mask (blk mask / res)
    (setq res (apply (function append)
                     (mapcar (function (lambda (x)
                                         (if (vlax-method-applicable-p blk x)
                                           (_kpblc-conv-vla-to-list (vlax-invoke-method blk x))
                                         ) ;_ end of if
                                       ) ;_ end of lambda
                             ) ;_ end of function
                             '("getattributes" "getconstantattributes")
                     ) ;_ end of mapcar
              ) ;_ end of apply
    ) ;_ end of setq
    (if (or (not mask) (= mask "*"))
      res
      (vl-remove-if-not
        (function (lambda (x) (wcmatch (strcase (vla-get-tagstring x)) (strcase mask))))
        res
      ) ;_ end of vl-remove-if-not
    ) ;_ end of if
  ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for item (vla-get-layers adoc)
    (setq layer_status
           (cons (cons
                   item
                   (mapcar (function (lambda (prop / temp)
                                       (setq temp (vlax-get-property item prop))
                                       (vl-catch-all-apply (function (lambda () (vlax-put-property item prop :vlax-false))))
                                       (cons prop temp)
                                     ) ;_ end of lambda
                           ) ;_ end of function
                           '("freeze" "lock")
                   ) ;_ end of mapcar
                 ) ;_ end of cons
                 layer_status
           ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of vlax-for

  (setq search_sym "$")

  (vlax-for blk_def (vla-get-blocks adoc)
    (vlax-for ent blk_def
      (cond
        ((wcmatch (vla-get-objectname ent) "AcDbAttr*Def*")
         (vla-put-layer ent "0")
        )
        ((wcmatch (vla-get-layer ent) (strcat "*" search_sym "#*" search_sym "*"))
         (setq name (substr (vla-get-layer ent) (+ 2 (vl-string-search search_sym (vla-get-layer ent)))))
         (setq new_layer (vla-add (vla-get-layers adoc)
                                  (substr name
                                          (+ 2 (vl-string-search search_sym name))
                                  ) ;_ end of substr
                         ) ;_ end of vla-add
         ) ;_ end of setq
         (vla-put-layer ent (vla-get-name new_layer))
         (if (wcmatch (vla-get-objectname ent) "AcDbBlockRef*")
           (foreach att (_kpblc-block-attr-get-pointer-mask ent nil)
             (vla-put-layer att (vla-get-name new_layer))
           ) ;_ end of foreach
         ) ;_ end of if
        )
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for

  (foreach item layer_status
    (if (not (vlax-object-released-p (car item)))
      (foreach prop (cdr item)
        (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car prop) (cdr prop)))))
      ) ;_ end of foreach
    ) ;_ end of if
  ) ;_ end of foreach

  (vla-auditinfo adoc :vlax-true)
  (repeat 3 (vla-purgeall adoc))

  (vla-endundomark adoc)
  (princ)
) ;_ end of defun
----- добавлено через ~1 мин. -----
Код не проверял - ты же не предоставил образца файла. Зажилил
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Последний раз редактировалось Кулик Алексей aka kpblc, 15.09.2022 в 08:02.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2022, 10:39
#9
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

потестил.
в обоих случаях выдает
Код:
[Выделить все] 
 ; error: bad argument type: consp #<VLA-OBJECT IAcadLayer 0000021ce7842568>
на всякий случай прикреляю тестовый файл
Вложения
Тип файла: dwg
DWG 2018		 test.dwg (3.54 Мб, 4 просмотров)
Composter вне форума  
 
Непрочитано 14.09.2022, 11:52
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Код изменил. А в твоем файле нет внедренных слоев с именами "*$0$*". А те, что есть, относятся к внешним ссылкам, которые сначала надо внедрить. И только потом уже ковыряться с именами.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2022, 12:21
#11
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

теперь
Код:
[Выделить все] 
 too few arguments
с версией файла обшибся, вот тут есть такие слои https://disk.yandex.ru/d/aE5eshSIXnmsMQ
Composter вне форума  
 
Непрочитано 14.09.2022, 12:27
#12
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Ну пройдись по коду, там несложно все в общем-то. Скорее всего, где-то я опечатался или параметр забыл.

----- добавлено через ~2 мин. -----
И что, понятие архивов уже под запретом?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Последний раз редактировалось Кулик Алексей aka kpblc, 14.09.2022 в 12:39.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2022, 13:37
#13
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

архив более 10 мегов, и сайт ругается
пришлось осваивать vlide .Методом тыка нашел что ошибка тут
Код:
[Выделить все] 
 (_kpblc-block-attr-get-pointer-mask ent)
судя по всему
Код:
[Выделить все] 
 (defun _kpblc-block-attr-get-pointer-mask (blk mask / res)
нужна какая то маска еще
Composter вне форума  
 
Непрочитано 14.09.2022, 13:50
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Composter, как же ты пишешь коды, если базовые вещи покрыты завесой тайны? Что такое параметры вызова функций?

----- добавлено через 54 сек. -----
Подсказка - второй параметр пропущен, чего лисп не позволяет делать. Проанализируй код, и минут за 5 поймешь, что и куда надо добавить
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2022, 14:28
#15
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

я ж инженер,а не программист. мне за код не плотют.

так я ж и написал что не хватает переменной mask в момент вызова функции _kpblc-block-attr-get-pointer-mask в сообщении выше

единственное мое предположение было что подставить туда search_sym. попробовал, заработало, но результат работы в файле такой же как и в моем лиспе
Composter вне форума  
 
Непрочитано 14.09.2022, 14:46
#16
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Туда не search_sym надо подставлять, а маску тэга атрибута. Либо nil, либо "*" - что больше нравится
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2022, 16:58
#17
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445

спасибо . Заработало.
Composter вне форума  
 
Непрочитано 14.09.2022, 17:00
#18
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,844

Кто б сомневался
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Редактирование имен слоев после внедрения внешних ссылок. Не все слои обрабатывает.

Размещение рекламы

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Revit 2017. Работа с материалами из внешних ссылок AlIgMi Revit 2 03.02.2017 17:38
Как сделать так, чтобы в диспетчере слоев перечня слоев внешних ссылок не было? yannay AutoCAD 3 12.05.2015 17:29
Как получить список имен слоев чертежа в .NET API AutoCAD 2010? лузер .NET 1 24.02.2014 02:08
lisp и фильтры слоев Mikka LISP 6 22.10.2010 11:49

Обратная связь - Вверх