LISP/Command - new layers

[Anonymous]

Trying to create a Demolition plan. I want to create new layers with the same name but add a -demo to the suffix. But I also want to keep the original layer.

For example:

E-CONCRETE

E-CONCRETE-DEMO

Ultimately I would love to have a demo command button. This button would allow me to select the entity, change it to the new layer with the -demo suffix, and change the color. This way I can go around the survey, and easily click the items i want to be demo'd.

Hope that makes sense.

Does something like this already exist?

[Kent1Cooper]

Try this as a start:

(defun C:DEMO (/ esel ent DLname)
  (while (setq esel (entsel "\nPick object to put on its Demo Layer: "))
    (setq
      ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "-DEMO")
    )
    (command
      "_.layer" "_make" DLname "_color" 8 "" "_ltype" "HIDDEN2" "" ""
      "_.chprop" ent "" "_layer" DLname ""
    )
  )
  (princ)
)

Use a color and linetype suited to your needs -- mine are assumptions.  Although it's not necessary, it could be made to check, for each object, whether  its corresponding -DEMO Layer already exists, instead of just Making it regardless -- more code, but perhaps faster by milliseconds that you'd never notice when selecting something with such a Layer already in the drawing.  And it could check that a selected object is not already  on a -DEMO Layer, so you don't get Layer names ending in -DEMO-DEMO and so on.  And it could check for locked Layers, and override Properties, and probably some other potential complications.  And it could be made to let you select everything at once, instead of only one at a time, and process each according to its own current Layer.

[Anonymous]

This is perfect! thank you! I will have to research on how to add the additional code so I don't get the -demo-demo and add multiple entity selection.

[ronjonp · Accepted solution]

Give this a try for multiple selection:

(defun c:laysuf	(/ e el l f s tm)
  ;; RJP - 04.03.2018
  (or (setq f (getenv "RJP_LayerSuffix")) (setq f (getenv "username")))
  (if (and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter suffix [<" f ">]: "))) tm))
			 (f)
		   )
	   )
	   (setq s (ssget ":L" (list (cons 8 (strcat "~*" f)))))
      )
    (progn (setenv "RJP_LayerSuffix" f)
	   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (setq l (cdr (assoc 8 (entget e))))
	     (setq el (entget (tblobjname "layer" l)))
	     (if (not (tblobjname "layer" (strcat l f)))
	       (entmakex (subst (cons 2 (strcat l f)) (assoc 2 el) el))
	     )
	     (entmod (subst (cons 8 (strcat l f)) (assoc 8 (entget e)) (entget e)))
	   )
    )
  )
  (princ)
)

[Anonymous]

That works the same as the previous lisp. I guess what I meant by multiple selection was using a window'd selection.

[ronjonp]

Did you try it? it also clears up your "-demo-demo" problem.

[Anonymous]

ah ha! New to the lisp routines and how they work. Was using the wrong command to execute it. works great!

[Kent1Cooper]

---

@Anonymous wrote:

This is perfect! thank you! I will have to research on how to add the additional code so I don't get the -demo-demo and add multiple entity selection.

---

You have a solution, but here's the extension of my earlier routine to incorporate those aspects.  [And as with that one, it's DEMO-specific, rather than usable for any Layer-name suffix.]

(defun C:DEMO (/ esel ent DLname)
  (prompt "\nTo move object(s) to corresponding -DEMO Layers,")
  (if (setq ss (ssget ":L"))
    (repeat (setq n (sslength ss))
      (setq
        ent (ssname ss (setq n (1- n)))
        edata (entget ent)
      ); setq
      (if (not (wcmatch (strcase (cdr (assoc 8 edata))) "*-DEMO")); not already on such a Layer
        (command
          "_.layer" "_make" (setq DLname (strcat (cdr (assoc 8 (entget ent))) "-DEMO")) "_color" 8 "" "_ltype" "HIDDEN2" "" ""
          "_.chprop" ent "" "_layer" DLname ""
        ); command
      ); if
    ); repeat
  ); if
  (princ)
); defun

[ronjonp]

Kent,

FWIW, you could filter out the selection first like so: 

(setq ss (ssget ":L" '((8 . "~*-DEMO"))))

There is a typo in my code above but I'm unable to edit:

;; Change this
((/= "" (setq tm (getstring (strcat "\nEnter suffix [<" f ">]: "))) tm))
;; to this
((/= "" (setq tm (getstring (strcat "\nEnter suffix [<" f ">]: ")))) tm)