Change Layer-Keep original pro

BibJim2112 · 发表于 2022-7-5 17:37:35

I am looking for a LISP routine that will change the layer of multiple objects yet have is so each object maintains the same properties(i.e. color, linetype) of the original layer.

Thanks BigJim2112

My name was suppose to be BigJim2112 not "Bib" but must have pressed the wrong button. :roll:

Tharwat · 发表于 2022-7-5 17:45:34

Welcome to CADTutor.

Try this program;

copy

(defun c:chglay  (/ lay sel int) ;; Tharwat - date: 30.may.2016 ;; (cond   ((and (setq lay (getstring t "\nSpecify layer name:"))         (not (tblsearch "LAYER" lay)))    (alert (strcat "Layer name  is not found !")))   ((and (princ (strcat "\nSelect objects to move to layer  :"))         (setq sel (ssget "_:L" '((0 . "~VIEWPORT")))))    (repeat (setq int (sslength sel))      (entmod (append (entget (ssname sel (setq int (1- int))))                      (list (cons 8 lay)'(62 . 256) '(6 . "ByLayer") '(370 . -1))))      )    )   ) (princ) )

BibJim2112 · 发表于 2022-7-5 17:51:01

Thanks Tharwat for the post. The routine changes the layers of the objects but the objects take on the color and linetype of the new layer.

BIGAL · 发表于 2022-7-5 17:54:34

BibJim2112 you need a two step entmod read the colour and linetype of the object and reset the "bylayer" to the old colour, if (assoc 62 obj) returns nil then obj is by layer so you must then go and read the layer table to find its default color setting.

copy

; not tested !!(repeat (setq int (sslength sel))(setq obj (ssname sel (setq int (1- int))))(setq col (assoc 62 obj)) ; need check here for by colour and look up layer table(setq lt (assoc 1 obj)) ; need check here for by layer and look up layer table      (entmod (append obj)                      (list (cons 62 Col))                      (list (cons 6 Lt))                      (list (cons 8 lay))      )

Tharwat · 发表于 2022-7-5 18:00:10

I thought you did want them to change as described into your first post !
Anyway CODES UPDATED ABOVE.

Lee Mac · 发表于 2022-7-5 18:00:53

Assuming I've correctly understood, please try the following:

copy

(defun c:layerchange ( / enx idx itm lay lst new old sel )   (while (and (/= "" (setq new (getstring t "\nSpecify new layer: "))) (not (snvalid new)))       (princ "\nLayer name invalid.")   )   (if (and (/= "" new) (setq sel (ssget "_:L" '((0 . "~VIEWPORT")))))       (repeat (setq idx (sslength sel))           (setq enx (entget (ssname sel (setq idx (1- idx))))                 old (assoc 8 enx)           )           (if (setq itm (cdr (assoc old lst)))               (setq enx (append enx itm))               (setq lay (entget (tblobjname "layer" (cdr old)))                     lst (cons (list old (assoc 62 lay) (assoc 6 lay) (assoc 370 lay)) lst)                     enx (append enx (cdar lst))               )           )           (entmod (subst (cons 8 new) old enx))       )   )   (princ))

guran · 发表于 2022-7-5 18:09:15

Thank you Lee Mac. Very nice lisp to have if you want to move things to a hidden layer, but still want everything to look the same.

Lee Mac · 发表于 2022-7-5 18:12:49

You're welcome - I'm glad you find it useful!

BibJim2112 · 发表于 2022-7-5 18:15:32

Thanks guys for the help on this!!!! Programs work amazing. Lee Mac...not only has your program worked flawlessly but you have some cool stuff on your website. I am just starting to learn LISP and your site was a HUGE help. If you ever get to Orlando Florida I will buy you a beer(assuming you are 21 of course). LOL

Lee Mac · 发表于 2022-7-5 18:19:16

Many thanks Jim - I'm delighted that you find the program and my site so useful, and I'll certainly keep your offer in mind if ever I'm in Orlando!

[编程交流] Change Layer-Keep original pro

发表回复

精选推荐