Changing only certain layers colors.

[kennethm]

I've been working on a lisp program to go into a drawing and grey out the majority of layers. Certain ones will need to  stay the same like the title block layer. But others will be unique to each individual drawing, so I need to be able to have the user input the layer name. I've tried a little coding but I'm am very much a amateur, trying to learn.

Any help would be really helpful.

[dlanorh]

Try this :

(defun c:foo (/ *error* c_doc c_lyrs lyr_lst valid lst)
  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq
  
  (vlax-for lyr c_lyrs
    (setq lyr_lst (cons (vlax-get-property lyr 'name) lyr_lst))
  );end_for
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (while (not x_it)
    (setq lyr_name (getstring T "\nEnter Layer Name to Grey : "))
    (cond ( (and (> (strlen lyr_name) 0) (vl-position lyr_name lyr_lst))
            (vlax-put-property (vla-item c_lyrs lyr_name) 'color 252)
          )
          ( (= (strlen lyr_name) 0) (setq x_it T))
          (t (alert (strcat "Layer : " lyr_name " Not present in this drawing")))
    );end_cond
    (setq lyr_name nil)
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))  
);end_defun

It will continue to ask for layer names until an empty string (enter or right click at the prompt) is found. It will then exit.

[Moshe-A]

@kennethm  hi,

well done, for start it is good 

here is my fix, instead of calling the (command) function each time i collect the layers name in one list (cause this is lisp  language) than concatenate it to string. note the use of (apply 'strcat layers^)  which returns one big string separate by commas.  on the other hand too many layers may result a too long string that autolisp string can not hold, in that case you will have to revert to your way.

moshe

(defun C:TEST (/ conv tbl lay layers^)
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (setq conv (getstring T "\nEnter Conveyor Name:")) ;Sets the conveyor name
 (while (setq tbl (tblnext "layer" (not lay)))
  (setq lay (cdr (assoc 2 tbl)))
  (if (not (wcmatch (strcase conv) "*Q*")) ; if the layer doesn't contain "q" then proceed, else move on to next layer
   (setq layers^ (cons (strcat "," lay) layers^))  
  )
 ); while

 (command "._layer" "_color" 252 (substr (apply 'strcat layers^) 2) "")

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)      
)

[Kent1Cooper]

If you want to keep it short and simple with a minimal adjustment to your code, try changing this:

  (if (not (wcmatch conv "q"));if the layer doesn't contain "q" ....

to this:

  (if (not (wcmatch conv "*q*"))

Your original would "see" only strings whose entire content  is "q", whereas the * wildcard [that's what the wc in (wcmatch) stands for] is a stand-in for any other character(s) [including none at either or both positions], so it will see any string that contains  a q anywhere in it.

[kennethm]

This great  but some of my bigger projects can have up to 800 layers, including the xref layers so this just might take too long.

[dlanorh]

OK, so coming from the other direction, you enter the layer names to exclude from greying. If certain layers are always excluded you need to hard code a list of their name so they can be excluded automatically. See line with red text comment

(defun c:foo (/ *error* c_doc c_lyrs x_lst lyr_lst x_it lyr_name)
  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        x_lst (list "0" );;ADD/CHANGE ALWAYS EXCLUDED LAYERS HERE
  );end_setq
  
  (vlax-for lyr c_lyrs
    (if (not (vl-position (vlax-get-property lyr 'name) x_lst)) (setq lyr_lst (cons (strcase (vlax-get-property lyr 'name)) lyr_lst)))
  );end_for
    
  (while (not x_it)
    (setq lyr_name (getstring T "\nEnter Layer Name to Exclude : "))
    (cond ( (and (> (strlen lyr_name) 0) (vl-position (strcase lyr_name) lyr_lst))
            (setq lyr_lst (vl-remove (strcase lyr_name) lyr_lst))
          )
          ( (= (strlen lyr_name) 0) (setq x_it T))
          (t (alert (strcat "Layer : " lyr_name " Not present in this drawing")))
    );end_cond
    (setq lyr_name nil)
  );end_while

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (vlax-for lyr c_lyrs
    (if (vl-position (strcase (vlax-get-property lyr 'name)) lyr_lst) (vlax-put-property lyr 'color 252))
  );end_for
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))  
);end_defun

Otherwise it works as before

[ВeekeeCZ]

---

@kennethm wrote:

I've been working on a lisp program ...

---

Picked it up where you left. Read the commentaries. 

(defun c:Test (/ lay)

  (setq lays1 (getstring T "\nLayers to stay colored (delimited by comma):")) 		; Sets the conveyor name   ; missing parenthesis     - user prompt (copy paste) for  unique to each individual drawing
  (setq lays2 ("Title1,Title2")) 							;  Certain ones will need to  stay the same like the title block layer
  
        										; (alert conv) removed - guess it was just for testing

  (command "_.layer") 			; open 'layer' command 

  (while (setq lay (cdr (assoc 2 (tblnext "layer" (not lay)))))     			; (conv) - syntax is bad. conv is not a function but variable. But also logic is bad. Correct is (not lay) - it should return T for 1st run, nil for all next.
    (if (and (not (wcmatch lay "*q*"))							;if the layer doesn't contain "q" then proceed, else move on to next layer
             (not (wcmatch lay lays1))
             (not (wcmatch lay lays2))
             )
      (command "_color" 252 lay)))  	; inside 'layer' command
  (command "") 				; close 'layer' command    - this way the Layer command makes one UNDO record and one LAYERP record.

  (princ)  ; Text function does not leave with nil
  )