HELP - Test for layer, create layer, move object to layer

[c3dnut]

I need to create a LISP routine that will allow you to select an object, find that objects layer, crate a new layer from the objects layer with a "V-DEMO-" layer name prefix and all the same setting as the original layer, then move the object to the new layer. Problem arises when the new layer already exists. I used a condition to determine if the new layer exists or not and if it does it moves the object to that layer as desired however; if the layer already exists it continues to add a "V-DEMO-" prefix and moves the object to that layer which is not the desired effect. I am fairly new to LISP and in over my head on this. Not sure if the condition statement itself is failing or if it is the False Condition command that is failing. Any help would be greatly appreciated, Thanks, in advance

(defun c:demolay 

	(/ ent elay newlay) ;Defines Variables

	(setq ent (entsel "\nSelect entity on layer to duplicate: ")) ;Sets variable ENT to selected object 

	(setq elay (cdr (assoc 8 (entget (car ent))))) ;Sets Variable ELAY to layer of object ENT

	(setq newlay (strcat "V-DEMO-" elay)) ;Sets Variable NEWLAY by adding "V-DEMO-LAY to ENT

(cond ((tblsearch "LAYER" newlay) ;Test to seey if layer NEWLAY exists

	(command "_.chprop" ent "" "LA" newlay "")) ;True Condition - Move object ENT to that layer

	((progn (setq laylist (entget (tblobjname "layer" elay)) laylist (subst (cons 2 newlay) (assoc 2 laylist) laylist ))
				(entmake laylist) 
				(command "_.chprop" ent "" "LA" newlay ""))
	);False Condition - Make layer NEWLAY while copying setting from ELAY and moves object ENT to layer NEWLAY

);Close Conditions

(princ)

);Close Function

.

[mhupp]

Close give this a try.

 

(defun c:demolay (/ *error* ent lay newlay) ;Defines Variables
  (while (setq ent (car (entsel "\nSelect Entity: "))) ;while will allow you to keep selecting one thing at a time with out exiting the command
    (setq newlay (strcat "V-DEMO-" (setq lay (cdr (assoc 8 (setq ent (entget ent)))))))
    (if (= (vl-string-search "V-DEMO-" lay) nil) ;prevents "V-DEMO-V-DEMO-layername"
      (if (tblsearch "LAYER" newlay)
        (entmod (subst (cons 8 newlay) (assoc 8 ent) ent))
        (progn
          (entmake (list '(00 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 newlay)))
          (entmod (subst (cons 8 newlay) (assoc 8 ent) ent))
        )
      )
      (progn
        (prompt (strcat "\nSelect Again Enity Already on \"" lay "\""))
      )
    )
  )
  (princ)
)

 

Edited February 3, 2023 by mhupp

[ronjonp]

I've had this one in the toolbox for a while:

(defun c:layerprefix (/ e el l f s tm)
  ;; RJP - 04.03.2018
  (or (setq f (getenv "RJP_LayerPrefix")) (setq f (getenv "username")))
  (if (and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter prefix [<" f ">]: ")))) tm)
			 (f)
		   )
	   )
	   (setq s (ssget ":L" (list (cons 8 (strcat "~" f "*")))))
      )
    (progn (setenv "RJP_LayerPrefix" 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 f l)))
	       (entmakex (subst (cons 2 (strcat f l)) (assoc 2 el) el))
	     )
	     (entmod (subst (cons 8 (strcat f l)) (assoc 8 (entget e)) (entget e)))
	   )
    )
  )
  (princ)
)

 

[c3dnut]

16 hours ago, ronjonp said:

I've had this one in the toolbox for a while:

(defun c:layerprefix (/ e el l f s tm)
  ;; RJP - 04.03.2018
  (or (setq f (getenv "RJP_LayerPrefix")) (setq f (getenv "username")))
  (if (and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter prefix [<" f ">]: ")))) tm)
			 (f)
		   )
	   )
	   (setq s (ssget ":L" (list (cons 8 (strcat "~" f "*")))))
      )
    (progn (setenv "RJP_LayerPrefix" 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 f l)))
	       (entmakex (subst (cons 2 (strcat f l)) (assoc 2 el) el))
	     )
	     (entmod (subst (cons 8 (strcat f l)) (assoc 8 (entget e)) (entget e)))
	   )
    )
  )
  (princ)
)

 

Thanks, ronjonp this is even better than what I was trying to do and is exactly what I needed! 

[ronjonp]

Glad to help