Modify layer description in lisp

[Anonymous]

I've got a layer setup in a lisp that I want to assign different Layer Description into each on of them. Which part is controlling layer description in a lisp? Here is part of my lisp:

....
(entmakex (list '(0 . "LAYER")
			  (cons 100 "AcDbSymbolTableRecord")
			  (cons 100 "AcDbLayerTableRecord")
			  (cons 2 "PIPE_S")
			  (cons 70 0)
			  (cons 62 6)
			  (cons 6 "Center")
			  (cons 370 25)))))
.....

Thanks

[regisrohde]

I think this can help you:

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-new-layers-lisp/td-p/3560508

[ВeekeeCZ · Accepted solution]

I'll make it easier for you...

Spoiler

(vl-load-com)

(defun c:XX (/ ss i sset oEXPERT cmde tmod llst la lnam lfrz loff)
  (setq oEXPERT (getvar 'EXPERT))
  (prompt "\n Select object to put on layer [PIPE_S].. ") ;unify the layer name, is it PIPE_S or PIP_S?
  (if (setq ss (ssget "_:L"))
    (repeat (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (if (not (tblsearch "LAYER" "PIPE_S"))
	(progn
	  (setvar 'EXPERT 3)
	  (command "_.-LINETYPE" "_LOAD" "Center" "acad.lin" "") ;change *.lin if different
	  (entmakex (list '(0 . "LAYER")
			  (cons 100 "AcDbSymbolTableRecord")
			  (cons 100 "AcDbLayerTableRecord")
			  (cons 2 "PIPE_S")
			  (cons 70 0)
			  (cons 62 6)
			  (cons 6 "Center")
			  (cons 370 25)))
	  (vla-put-description (vlax-ename->vla-object (tblobjname "LAYER" "PIPE_S")) "Your description")
	)
      )	
      (entmod (subst (cons 8 "PIPE_S")
		     (assoc 8 (entget sset))
		     (entget sset))))
    (princ "\n Nothing selected "))

  (setq cmde (getvar "cmdecho") ;here was an extra left bracket
	tmod (getvar "tilemode")
	llst ""
	la (tblnext "layer" T))

  (setvar "cmdecho" 0)
  (while la
    (setq lnam (cdr (assoc 2 la))
	  lfrz (= (logand (cdr (assoc 70 la)) 1) 1)
	  loff (minusp (cdr (assoc 62 la))))
    (if (or lfrz loff)
      (progn
	(if (setq ss (ssget "x" (list (cons 8 lnam))))
	  (command "_.-layer" "_u" lnam ""
		   "_.erase" ss ""))
	(setq llst (strcat lnam "," llst)
	      la (entget (tblobjname "layer" lnam))
	      la (subst '(70 . 0)(assoc 70 la) la))
	(entmod la)))
    (setq la (tblnext "layer")))
  (if (> llst "")
    (command "_.tilemode" 0
	     "_.vplayer" "_t" llst "_a" ""))
  (repeat 3
    (command "_.purge" "_a" "*" "_n")) 
  (setvar 'EXPERT oEXPERT)
  (setvar "cmdecho" cmde) 
  (setvar "tilemode" tmod) 
  (princ) 
)

[pbejse]

---

@Anonymous wrote:

... Which part is controlling layer description in a lisp? Here is part of my lisp:

---

Try this..

(progn
  (regapp "AcAecLayerStandard")
  (entmake
    (append
      (list '(0 . "LAYER")
	    (cons 100 "AcDbSymbolTableRecord")
	    (cons 100 "AcDbLayerTableRecord")
	    (cons 2 "PIPE_S")
	    (cons 70 0)
	    (cons 62 6)
	    (cons 6 "Center")		;<< make sure linetype is loaded
	    (cons 370 25)
      )
      (list
	(list -3
	        (list "AcAecLayerStandard"
	            (cons 1000 "")
	            (cons 1000 "Description Here")
	        )
	    )
	)
    )
  )
)

HTH

[Anonymous]

and if I want to add a Warning messge to this routine's body?? 

(vl-load-com)

(defun c:XX (/ ss i sset oEXPERT cmde tmod llst la lnam lfrz loff)
  (setq oEXPERT (getvar 'EXPERT))
  (prompt "\n Select object to put on layer [PIPE_S].. ") ;unify the layer name, is it PIPE_S or PIP_S?
  (if (setq ss (ssget "_:L"))
    (repeat (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (if (not (tblsearch "LAYER" "PIPE_S"))
	(progn
	  (setvar 'EXPERT 3)
	  (command "_.-LINETYPE" "_LOAD" "Center" "acad.lin" "") ;change *.lin if different
	  (entmakex (list '(0 . "LAYER")
			  (cons 100 "AcDbSymbolTableRecord")
			  (cons 100 "AcDbLayerTableRecord")
			  (cons 2 "PIPE_S")
			  (cons 70 0)
			  (cons 62 6)
			  (cons 6 "Center")
			  (cons 370 25)))
	  (vla-put-description (vlax-ename->vla-object (tblobjname "LAYER" "PIPE_S")) "Your description")
	)
      )	
      (entmod (subst (cons 8 "PIPE_S")
		     (assoc 8 (entget sset))
		     (entget sset))))
    (princ "\n Nothing selected "))

  (setq cmde (getvar "cmdecho") ;here was an extra left bracket
	tmod (getvar "tilemode")
	llst ""
	la (tblnext "layer" T))

  (setvar "cmdecho" 0)
  (while la
    (setq lnam (cdr (assoc 2 la))
	  lfrz (= (logand (cdr (assoc 70 la)) 1) 1)
	  loff (minusp (cdr (assoc 62 la))))
    (if (or lfrz loff)
      (progn
	(if (setq ss (ssget "x" (list (cons 8 lnam))))
	  (command "_.-layer" "_u" lnam ""
		   "_.erase" ss ""))
	(setq llst (strcat lnam "," llst)
	      la (entget (tblobjname "layer" lnam))
	      la (subst '(70 . 0)(assoc 70 la) la))
	(entmod la)))
    (setq la (tblnext "layer")))
  (if (> llst "")
    (command "_.tilemode" 0
	     "_.vplayer" "_t" llst "_a" ""))
  (repeat 3
    (command "_.purge" "_a" "*" "_n")) 
  (setvar 'EXPERT oEXPERT)
  (setvar "cmdecho" cmde) 
  (setvar "tilemode" tmod) 
  (princ) 
)

Thanks

[ВeekeeCZ]

Ok, I added Henrique's suggestion into your routine. Also I rearranged that a little bit...

Spoiler

(vl-load-com)

(defun c:XX ( /  *error* ss i sset oCMDECHO oTILEMODE oEXPERT llst la lnam lfrz loff)


  ;-----
  (defun *error* (errmsg)
    (if	(not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    
    (setvar 'CLAYER oCLAYER)
    (setvar 'TILEMODE oTILEMODE)
    (setvar 'CMDECHO oCMDECHO)
    (vla-endundomark doc)
    (princ)
  )

  ;--------------------------------------------------------------------------------------------

  (setq oCMDECHO (getvar 'CMDECHO))
  (setq oTILEMODE (getvar 'TILEMODE))
  (setq oEXPERT (getvar 'EXPERT))

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setvar 'CMDECHO 0)


  (prompt "\n Select object to put on layer [PIPE_S].. ")
  (if (setq ss (ssget "_:L"))
    (repeat (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (if (not (tblsearch "LAYER" "PIPE_S"))
	(progn
	  (setvar 'EXPERT 3)
	  (command "_.-LINETYPE" "_LOAD" "Center" "acad.lin" "")
	  (entmakex (list '(0 . "LAYER")
			  (cons 100 "AcDbSymbolTableRecord")
			  (cons 100 "AcDbLayerTableRecord")
			  (cons 2 "PIPE_S")
			  (cons 70 0)
			  (cons 62 6)
			  (cons 6 "Center")
			  (cons 370 25)
		    )
	  )
	  (vla-put-description (vlax-ename->vla-object (tblobjname "LAYER" "PIPE_S")) "Your description")
	)
      )
      (entmod (subst (cons 8 "PIPE_S")
		     (assoc 8 (entget sset))
		     (entget sset)
	      )
      )
    )
    (princ "\n Nothing selected ")
  )


  (if (= (ACET-UI-MESSAGE
	   "Do you want ERASE ALL objects on FROZEN and TURNED OFF layers?"
	   "Erase objects?"
	   (+ Acet:YESNO Acet:ICONWARNING)
	 )
	 6
      )
    (progn



      (setq llst ""
	    la	 (tblnext "layer" T)
      )

      (while la
	(setq lnam (cdr (assoc 2 la))
	      lfrz (= (logand (cdr (assoc 70 la)) 1) 1)
	      loff (minusp (cdr (assoc 62 la)))
	)
	(if (or lfrz loff)
	  (progn
	    (if	(setq ss (ssget "x" (list (cons 8 lnam))))
	      (command "_.-layer" "_u" lnam "" "_.erase" ss "")
	    )
	    (setq llst (strcat lnam "," llst)
		  la   (entget (tblobjname "layer" lnam))
		  la   (subst '(70 . 0)
			      (assoc 70 la)
			      la)
	    )
	    (entmod la)
	  )
	)
	(setq la (tblnext "layer"))
      )
      (if (> llst "")
	(command "_.tilemode" 0	"_.vplayer" "_t" llst "_a" "")
      )
    )
  )

  (repeat 3 (command "_.purge" "_a" "*" "_n"))

  
  (setvar 'TILEMODE oTILEMODE)
  (setvar 'EXPERT oEXPERT)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)