LISP Request / Code Change

[SnickerinTurtles]

Hi all, 

The code below was provided by Sea.Haven. It was his solution to a LISP command I requested in a different post  and I wanted to modify it a little bit, but I do not have the knowledge to do so. I am just getting into the LISP coding and have little to none knowledge about LISP code. I did do some C++ coding in my past and hopefully this knowledge will help me understand and jump into learning the LISP language a little faster. 

Anyways this is the code sea.haven came up with.

(defun c:xrlyrc2 ( / c_lyrs obj lay)
  (vl-load-com)
  (setvar 'xrefoverride 1)
  (setq c_lyrs (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (while (setq col (getreal "\nEnter colour number 1-255 Enter to Exit "))
    (setq obj (vlax-ename->vla-object (car (nentsel "\nselect xref layer"))))
    (setq lay (vla-get-layer obj))
    (vlax-for lyr c_lyrs
      (if (= (vlax-get lyr 'name) lay) (vlax-put lyr 'color col))
    )
	(command "regen")
  )
  (princ)
)
(c:xrlyrc2)

This code asks the user to select a color between 1-255 then asks the user to select which layer the user wants the color selected earlier to be applied to. 

There are 2 things I would like to modify if possible.

1) The order in which this code works. I would like to select the xref layer 1st then select the color.

2) Instead of telling the user to type in a color # between 1-255. Is it possible to have the "Select color"  window to pop-up. And have it say "Select Color from color pallet window." This is the pop-up I am thinking could pop-up.

Thanks for your help!

[ronjonp · Accepted solution]

Try this.

(defun c:clc (/ c d e l n)
  ;; RJP » 2018-08-17
  ;; Set layer color by pick
  (or (getenv "clc") (setenv "clc" "(62 . 1)"))
  (cond	((setq c (acad_truecolordlg (read (getenv "clc"))))
	 (setenv "clc" (vl-prin1-to-string (last c)))
	 (setq d (vla-get-activedocument (vlax-get-acad-object)))
	 (while	(setq e (car (nentsel "\nSelect entity to change layer color: ")))
	   (and	(setq n (cdr (assoc 8 (entget e))))
		(setq l (tblobjname "layer" n))
		(entmod (append (entget l) c))
	   )
	   (vla-regen d acactiveviewport)
	 )
	)
  )
  (princ)
)(vl-load-com)

You still have to pick the color first but this allows you to select multiple items to change.

Or for pick first then color:

(defun c:clc (/ c d e l n)
  ;; RJP » 2018-08-17
  ;; Set layer color by pick
  (if (setq e (car (nentsel "\nSelect entity to change layer color: ")))
    (progn (or (getenv "clc") (setenv "clc" "(62 . 1)"))
	   (cond ((setq c (acad_truecolordlg (read (getenv "clc"))))
		  (setenv "clc" (vl-prin1-to-string (last c)))
		  (setq d (vla-get-activedocument (vlax-get-acad-object)))
		  (and (setq n (cdr (assoc 8 (entget e))))
		       (setq l (tblobjname "layer" n))
		       (entmod (append (entget l) c))
		  )
		  (vla-regen d acactiveviewport)
		 )
	   )
    )
  )
  (princ)
)(vl-load-com)

[SnickerinTurtles]

Tried them both! They are great! So far no issues! I honestly like the 1st one better. since i can select multiple at a time its a pretty nice improvement and can definitely save a lot of time. I will post if any issues arise but it works just great for now. Thanks! 

[ronjonp]

---

@SnickerinTurtles wrote:

Tried them both! They are great! So far no issues! I honestly like the 1st one better. since i can select multiple at a time its a pretty nice improvement and can definitely save a lot of time. I will post if any issues arise but it works just great for now. Thanks! 

---

Glad to help 🙂

[Sea-Haven]

There is also the simpler (setq col (ACAD_COLORDLG 1)) where the number is between 1-256.

[ronjonp]

---

@Sea-Haven wrote:

There is also the simpler (setq col (ACAD_COLORDLG 1)) where the number is between 1-256.

---

Simpler but less options. Not sure where that adds value?

[Sea-Haven]

Its if you just use a color number.

[ronjonp]

---

@Sea-Haven wrote:

Its if you just use a color number.

---

I don't follow? With acad_colordlg you get one choice, with acad_truecolordlg you get 3 choices one of which includes the index color. 

[SnickerinTurtles]

sea.haven thanks for joining! Glad you popped in! I was hoping you'd find this post. Happy, to get your input and learn different methods. Thanks again.

[SnickerinTurtles]

So for my understand this part in the code 

(cond ((setq c (acad_truecolordlg (read (getenv "clc"))))

more specifically the "acad_truecolordlg"  brings up the 3 choices or the color pick pop-up window appear where as if it was replaced with "acad_colordlg" instead of the pop-up it would be typing in the color number.

truecolordlg stands for true color dialog box?

colordlg is color dialog box?

If so I would assume there is one for linetype dialog box and any other dialog box in CAD?

[timothy_crouse]

Could this code be modified to select an entire XREF file?

Would it be possible to change all layers in an xref  EXCEPT ones with "new" in the name to a new color

and change all the xref layer names with "new" in the name to a different color?

I am trying to come up with a way to go back and forth between DARKK and LIGHT modes of work environment in ACAD.  I own the drawings so modifying the working drawing is not a standard issue in this case.

Thanks in Advance

-Tim C.

[ronjonp]

@timothy_crouse Sorry for the delay been a bit busy. Give this a try. Note that the first color dialog box is the base color and the second is the "NEW" layer colors.

(defun c:clcxr (/ bn c c2 d e lyrs)
  ;; RJP » 2023-12-01
  ;; Set all top level XREF layers color by pick changing *NEW* to a different color
  (vlax-for x (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq lyrs (cons (list (vla-get-name x) (vlax-vla-object->ename x)) lyrs))
  )
  (if (setq e (car (cadddr (nentsel "\nSelect entity to change layer color: "))))
    (progn (if (wcmatch (setq bn (cdr (assoc 2 (entget e)))) "*|*")
	     (setq bn (substr bn 1 (vl-string-position 124 bn)))
	   )
	   (or (getenv "clc") (setenv "clc" "(62 . 1)"))
	   (cond ((and (setq c (acad_truecolordlg (read (getenv "clc"))))
		       ;; This is the color for the *NEW* layers
		       (setq c2 (acad_truecolordlg (read (getenv "clc"))))
		  )
		  (setenv "clc" (vl-prin1-to-string (last c)))
		  (setq d (vla-get-activedocument (vlax-get-acad-object)))
		  (foreach l lyrs
		    (if	(wcmatch (car l) (strcat bn "*"))
		      (if (wcmatch (strcase (car l)) "*NEW*")
			(entmod (append (entget (cadr l)) c2))
			(entmod (append (entget (cadr l)) c))
		      )
		    )
		  )
		  (vla-regen d acactiveviewport)
		 )
	   )
    )
  )
  (princ)
)
(vl-load-com)

[timothy_crouse]

First let me say thank you for taking the time to not only read but update the code per the request.

The code does perform the core functionality as requested.   Some Work-Flow improvements would be helpful:

1.  Lisp Runs

2.  Add an Option Choice:

-Perform Color Updated on All Attached XREFs

-Perform Color Change on Selected XREFs Only

3.  >> 2a gotto color selection routine

3 >> 2b Provide command line message:

"Select XREF Objects"

4.  User selects objects, code is smart enough to know if a duplicate XREF object was selected so an error is not generated, added not knowing if this would in-fact cause an issue.

5.  Color Selection Routine

5a -  Display command line message:

"Select color for existing object layers", Press any key to proceed"

5 b - Color Dialog pops up after tapping a key, would assume space or enter would typically be pressed

5c - Existing dialog color selection box closes

5d -  Display command line message:

"Select color for existing object layers", Press any key to proceed"

5e - Color Dialog pops up after tapping a key, would assume space or enter would typically be pressed

5c - New dialog color selection box closes.

Would it be possible to add some universal capability to layer group affected by the procedure:

Instead of the routine looking for two layer groups 'NOT "New"' & "New" characters in the layer name

add a third choice at step 2.

-Perform color update on user defined layer group

>> Next command prompt would ask the user to enter a filter

"NOT XXX" would affect layers without the XXX characters  OR

"XXX" would affect layers with the XXX characters in the name

Thoughts / Concerns

Best Regards

-Tim C.

[ronjonp]

@timothy_crouse Glad the code worked for you.

I don't have time at the moment to fulfill your list of requests .. sorry.

[timothy_crouse]

Understood, thank you for your time.

Best Regards

-Tim C.