• На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Тема: LISP. Дублирование объектов на другой слой

;*********** dup.lsp ***********************************
;   Дублирование объектов с текущего слоя на другой слой.
;   Для тех, у кого нет "Express Tools".
;
(defun C:DUP (/ CENT)
 (setvar "CMDECHO" 0)
 (princ "\n ДУБЛИРОВАНИЕ")
 (Command "_LAYER" "_N" "ДУБЛИКАТ" ^C)
 (setq CENT (ssget))
 (Command "_COPY" CENT "" "0,0" "0,0")
 (Command "_CHPROP" CENT "" "_LA"  "ДУБЛИКАТ" "")
 (Command "_LAYER" "_OFF" "ДУБЛИКАТ" ^C)
 (Command "_REDRAW")
 (setq CENT nil)
 (princ "\n Включите слой  ДУБЛИКАТ, чтобы увидеть копию.")
 (PRINC)
)

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:DUP) (load "dup")) DUP

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: LISP. Дублирование объектов на другой слой

> Владимир Громов
Прошу не воспринимать как критику:
Надо бы дополнительно восстановить состояние cmdecho после окончания выполнения программы. ИМХО вообще хорошим тоном будет восстанавливать состояние системных переменных, которые меняет функция.
Дополнительно:
Слой "Дубликат" уже может существовать в чертеже. Надо бы либо использовать опцию "_Make", либо проверять наличие слоя примерно следующей конструкцией:

(if (tblsearch "LAYER" "ДУБЛИКАТ")
(command "_.-Layer" "_Set" "ДУБЛИКАТ"); : TRUE - слой есть
(command "_.-Layer" "_Make" "ДУБЛИКАТ" "_Color" 2 "ДУБЛИКАТ"); : FALSE - слоя еще нет
);_if

. При текущем коде слой будет иметь такие же установки, как и текущий (я так полагаю). ИМХО надо для него сделать отдельный цвет как минимум. И потом, если некоторые элементы имели установки "по слою", они примут установки текущего слоя ("Дубликат"), т.е. чертеж может стать нечитаемым.
Также можно сделать метки начала и окончания группы отмены, но в данном случае этого не требуется.
И теперь критика: "_Layer" вызовет диалоговое окно. Надо "_-Layer"
---
ИМХО

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: LISP. Дублирование объектов на другой слой

> kpblc
Вообще говоря, слой "Дубликат" - временный слой, кому на самом деле нужно такое имя. После дублирования слой лучше сразу переименовать в более подходящий. Насчет восстановления переменных - согласен, и делаю это. Но cmdecho - не критическая переменная, я ее всегда выключаю.
А вот с "_-Layer" - не согласен в данном случае.
Все работает нормально. Хотя сам всегда именно так и пишу, если не хочу вызова диалогового окна. Если не веришь, скопируй этот код в командную строку AutoCAD'а и введи dup.

  • Runa
  • Восстановленный участник
  • На форуме с 21 января 2005г.
  • Сообщений: 79
  • Спасибо: 0

Re: LISP. Дублирование объектов на другой слой

> Владимир Громов
Для оптимизации предложил бы использовать (setq CENT (ssget "_:L")) - сразу будет видно не заблокированы ли слои

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: LISP. Дублирование объектов на другой слой

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

  • zhuravsky
  • Восстановленный участник
  • На форуме с 19 февраля 2004г.
  • Сообщений: 214
  • Спасибо: 0

Re: LISP. Дублирование объектов на другой слой

Еще один момент: на новый слой переносятся не копии ОРИГИНАЛЬНЫХ объектов, а сами ОРИГИНАЛЫ. Однажды, у меня был случай когда такое было недопустимо. Я решил проблему с помощью vla-copy.

  • zhuravsky
  • Восстановленный участник
  • На форуме с 19 февраля 2004г.
  • Сообщений: 214
  • Спасибо: 0

Re: LISP. Дублирование объектов на другой слой

Отыскал текст:

;*******************************************************************************
;  02.07.2004 15:26
;  c:laycpy -  command for copying the objects to another layer
;*******************************************************************************
(defun c:laycpy ( / ss older i lay)
  (ai_sysvar '("CMDECHO" . 0))
  (command "_.undo" "_group")
  (setq undo_flag T)
  (setq older *error* *error* ds_er)
  ;
  (while (null ss)
    (setq ss (ssget))
  );while
  (while (null lay)
    (setq lay (getstring (strcat "Enter new layer (Current is " (getvar "CLAYER") "): " )))
    (if (not (member lay (get_layers nil)))
      (setq lay nil)
    ); if
  );while
  (setq i 0)
  (repeat (sslength ss)
    (vla-put-layer (vla-copy (vlax-ename->vla-object (ssname ss i))) lay)
    (setq i (1+ i))
  ); repeat
  ;
  (setq *error* older)
  (command "_.undo" "_end")
  (setq undo_flag nil)
  (ai_sysvar nil)
  (princ)
); c:laycopy

Вместо ds_er нужно поставить свой обработчик ошибок - должно работать

  • zhuravsky
  • Восстановленный участник
  • На форуме с 19 февраля 2004г.
  • Сообщений: 214
  • Спасибо: 0

Re: LISP. Дублирование объектов на другой слой

Отыскал текст:

;*******************************************************************************
;  02.07.2004 15:26
;  c:laycpy -  command for copying the objects to another layer
;*******************************************************************************
(defun c:laycpy ( / ss older i lay)
  (ai_sysvar '("CMDECHO" . 0))
  (command "_.undo" "_group")
  (setq undo_flag T)
  (setq older *error* *error* ds_er)
  ;
  (while (null ss)
    (setq ss (ssget))
  );while
  (while (null lay)
    (setq lay (getstring (strcat "Enter new layer (Current is " (getvar "CLAYER") "): " )))
    (if (not (member lay (get_layers nil)))
      (setq lay nil)
    ); if
  );while
  (setq i 0)
  (repeat (sslength ss)
    (vla-put-layer (vla-copy (vlax-ename->vla-object (ssname ss i))) lay)
    (setq i (1+ i))
  ); repeat
  ;
  (setq *error* older)
  (command "_.undo" "_end")
  (setq undo_flag nil)
  (ai_sysvar nil)
  (princ)
); c:laycopy

Вместо ds_er нужно поставить свой обработчик ошибок, (get_layers nil)-возвращает список слоев чертежа без слоя "0", остальное вроде стандартное.