Simplify lisp, select object, change color (index/truecolor/colorbook)

Hello all,

I managed to build a lisp, that allows me to select a line, polyline, arc or circle of an Xref, and change the layercolor of that xref's-layer to a selected color, wich can be a indexcolor, truecolor or colorbook color...

However... i think this code can be WAY simpler...

Any suggestions?

(defun C:ChangeLayerColor ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor)
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(setq selectedobject (nentsel "\nSelect a line, polyline, circle or arc to change its layers color: "))
(if (/= selectedobject nil)
	(progn
		(if (/= (cdr (assoc 410 (entget (car selectedobject)))) nil)
			(progn
				(setq selectedobject (entget (car selectedobject)))
				(setq selectedobjecttype (cdr (assoc 0 selectedobject)))
			)
			(progn
				(setq selectedobject (entget (car (nth 3 selectedobject))))
				(setq selectedobjecttype (cdr (assoc 0 selectedobject)))
			)
		)
		(cond
			((= selectedobjecttype (car (member selectedobjecttype (list "LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))))
				(setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
			)
			(t
				(setq selectedobjectlayer nil)
			)		
		)
		(if (/= selectedobjectlayer nil)
			(progn
				(setq layercolor (acad_truecolordlg 253 nil))
				(if (/= layercolor nil)
					(progn
						(if (/= (car (cddr layercolor)) nil)
							(progn
								(setq layercolor (cdr (car (cddr layercolor))))
								(setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
								(setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
								(command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
								(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
							)
							(progn
								(if (/= (car (cdr layercolor)) nil)
									(progn
										(setq layercolor (OLEtoRGB_color (cdr (car (cdr layercolor)))))
										(setq layercolor (strcat (itoa (car layercolor))","(itoa (car (cdr layercolor)))","(itoa (car (cddr layercolor)))))
										(command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
										(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
									)
									(progn
										(setq layercolor (cdr (car layercolor)))
										(command-s "-Layer" "Color" layercolor selectedobjectlayer "")
										(princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
									)
								)
							)
						)
					)
					(progn
						(princ "\nCancelled...")
					)
				)
			)
			(progn
				(princ "\nInvalid selection.")
			)
		)
	)
	(progn
		(princ "\nCancelled...")
	)
)
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)

(defun OLEtoRGB_color (OLE_color / r g b)
 (setq r (lsh OLE_color -16))
 (setq g (lsh (lsh OLE_color 16) -24))
 (setq b (lsh (lsh OLE_color 24) -24))
 (list r g b)
)

(princ)

Hi Aftertouch. Here are few thougths.

(if (/= selectedobject nil) can be replaced by (if selectedobject. More concise and readable. There were few places you used the same kind of logic.

(if (/= (cdr (assoc 410 (entget (car selectedobject)))) nil) can be replaced by (if (assoc 410 (entget (car selectedobject))). If assoc 410 deosn't exist, it will return nil and evaluate the "else" part of the if. That being said, without in depth analysis I'm not sure why you check if 410 group code exist, and if so entget the nth 3 instead, but what I noticed is that since the selectedobjecttype is set to be the same in both cases, that part can be removed from the if instead of being duplicated in both of the if's conditions and place under. Doing so also enables the removals of the 2 prongs.

In the same kind of way, for your cond you just need to see if selectedobjecttype is a member of the list. If it is, the selectedobjecttype will always be equal to the car of the list returned by member. Also note that the (t part of your conditionnal is useless. If it is member of the list, selectedobjectlayer will be setted (cdr (assoc 8 selectedobject)), but if it is not a member, selectedobjectlayer does not exist, so you don't need to set it to nil as it already is nil. If you remove the (t part of the cond, you end up with a cond with a single condition, so it can be swapped for an if statement. Oh, and since the list wont vary you can quote it instead of building it using (list

(if (/= selectedobjectlayer nil) replaced by (if selectedobjectlayer

(if (/= layercolor nil) replaced by (if layercolor

Basically for the rest I used a cond instead of nested if's as it is more readable imo for the 3 choices (colorbook/true color/index). I also changed things like (cdr (car (cdr layercolor))) for (cdadr layercolor). Less parenthesis and more readability. I didn't modify anything else, since it seems to execute flawlessly.

(defun C:CLC ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor OLDCMDECHO)
(setq OLDCMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(setq selectedobject (nentsel "\nSelect a line, polyline, circle or arc to change its layers color: "))
(if selectedobject 
	(progn
		(if (assoc 410 (entget (car selectedobject)))
		    (setq selectedobject (entget (car selectedobject)))
		    (setq selectedobject (entget (car (nth 3 selectedobject))))
		)
                       (setq selectedobjecttype (cdr (assoc 0 selectedobject)))
		(if (member selectedobjecttype '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))
                           (setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
		)
		(if selectedobjectlayer
			(progn
				(setq layercolor (acad_truecolordlg 253 nil))
				(if layercolor
                                               (cond ((cddr layercolor)
                                                      (setq layercolor (cdaddr layercolor))
                                                      (setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
                                                      (setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
                                                      (command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
                                                     )
                                                     ((cdr layercolor)
                                                      (setq layercolor (OLEtoRGB_color (cdadr layercolor)))
                                                      (setq layercolor (strcat (itoa (car layercolor))","(itoa (cadr layercolor))","(itoa (caddr layercolor))))
                                                      (command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
                                                     )
                                                     ((setq layercolor (cdr (car layercolor)))
                                                      (command-s "-Layer" "Color" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
                                                     )
                                               )
					(princ "\nCancelled...")
				)
			)
			(princ "\nInvalid selection.")
		)
	)
	(princ "\nCancelled...")
)
(command "UNDO" "END")
(setvar "cmdecho" OLDCMDECHO)
(princ)
)

side notes: it is always preferable to avoid using (entget more than once. You do it with selectedobject, but since I don't understand what your goal is when you check the existance of 410 I cannot offer an alternative to calling entget more than once.

Don't change variables arbitrarly (like cmdecho). Set a variable OLDCMDECHO with the original value, change it to suit your needs. At the end, use OLDCMDECHO to restore the variable to its original value.

Cheers!

Hey Jef, thanks for the feedback.

About the assoc 410 part:

		(if (assoc 410 (entget (car selectedobject)))
		    (setq selectedobject (entget (car selectedobject)))
		    (setq selectedobject (entget (car (nth 3 selectedobject))))
		)

What im trying to do here, is when the selected object doesnt have the 410 property (Model), then its a part of a block.

In that case, use the (nth 3) of the selected object, wich is the parent block of the selected line (wich is in the block on layer 0).

You could also check the length of the nentsel list .. if it's nested, the length will be greater than two.

(setq e (nentsel))
(cond ((caddr e) (car (last e)))
     ((car e))
)

Here's an alternative way to structure the code too:

(if (and (setq selectedobject
	(nentsel "\nSelect a line, polyline, circle or arc to change its layer color: "
	)
 )
 (setq selectedobject
	(cond ((caddr selectedobject) (car (last selectedobject)))
	      ((car selectedobject))
	)
 )
 ;; Why check object type?
 (vl-position
   (cdr (assoc 0 (entget selectedobject)))
   '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC")
 )
 (setq layercolor (acad_truecolordlg 253 nil))
   )
 (cond	((assoc 430 layercolor) "do your colorbook stuff")
((assoc 420 layercolor) "do your truecolor stuff")
("do your aci stuff")
 )
)

Ah... I see. 2 things. Further down you check if the nature of the item is a member of that list:("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC") so you kind of check twice if it is a block insert then. I would get rid of that first extra step by using entsel instead of nentsel. Using entsel here will be the same operation for all entities. (Use nentsel only if you need nentsel).

You can further reduce the length of the code by moving the setq inside the if's.

so that

(setq thisvar ...)

(if thisvar

[true do this]

[false do this]

)

can be changed for that

(if (setq thisvar ...)

[true do this]

[false do this]

)

(defun C:CLC ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor OLDCMDECHO)
(setq OLDCMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(if (setq selectedobject (entsel "\nSelect a line, polyline, circle or arc to change its layers color: ")) 
	(progn
                       (setq selectedobjecttype (cdr (assoc 0 (setq selectedobject (entget (car selectedobject))))))
		(if (member selectedobjecttype '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))
                           (setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
		)
		(if selectedobjectlayer
			(progn
				(if     (setq layercolor (acad_truecolordlg 253 nil))
                                               (cond ((cddr layercolor)
                                                      (setq layercolor (cdaddr layercolor))
                                                      (setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
                                                      (setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
                                                      (command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
                                                     )
                                                     ((cdr layercolor)
                                                      (setq layercolor (OLEtoRGB_color (cdadr layercolor)))
                                                      (setq layercolor (strcat (itoa (car layercolor))","(itoa (cadr layercolor))","(itoa (caddr layercolor))))
                                                      (command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
                                                     )
                                                     ((setq layercolor (cdr (car layercolor)))
                                                      (command-s "-Layer" "Color" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
                                                     )
                                               )
					(princ "\nCancelled...")
				)
			)
			(princ "\nInvalid selection.")
		)
	)
	(princ "\nCancelled...")
)
(command "UNDO" "END")
(setvar "cmdecho" OLDCMDECHO)
(princ)
)

Other things I might do if this was my project: make a variant of OLEtoRGB_color that would return directly what you need ie "99,171,207" instead of (99 171 207) that you need to process further. Maybe a sub that accepts any color format and a layer as argument to make the color change accordingly. When different formats can be returned by a function like acad_truecolordlg (str or int in dotted pairs ((62 . 43) (420 . 13676676) (430 . "RAL CLASSIC$RAL 1001"))) using vl-princ-to-string can enable the removal of a bunch of lines of code. Less verification and unique way of processing. (vl-princ-to-string wathever instead of having to manipulate it in different ways depending of the nature. (itoa/rtos/as is if str)

As a last comment, when you have many if's it can be a challenge to follow the flow, and the code can spead over many many lines. They either can be nested or one after the other.

if (...) than do A

if A than do B

If B than do C

[b]Nested if:[/b]
(if (...)
 (if A
   (if B
     C)
 )
)
[b]Chain of if:[/b]
(if (...)
 A
)
(if A
   B
)
(if B
   C
)

[b]And alternative:[/b]
(and (...)
       A
       B
       C
)

And and Or functions can greatly help to make code more concise and readable. Look at Ron example

@Ronjonp You have a (list missing!

Ah... I see. 2 things. Further down you check if the nature of the item is a member of that list:("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC") so you kind of check twice if it is a block insert then. I would get rid of that first extra step by using entsel instead of nentsel. Using entsel here will be the same operation for all entities. (Use nentsel only if you need nentsel).

 

You can further reduce the length of the code by moving the setq inside the if's.

 

 

(defun C:CLC ( / selectedobject selectedobjecttype selectedobjectlayer layercolor colorbook colorbookcolor OLDCMDECHO)
(setq OLDCMDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")
(if (setq selectedobject (entsel "\nSelect a line, polyline, circle or arc to change its layers color: ")) 
	(progn
                       (setq selectedobjecttype (cdr (assoc 0 (setq selectedobject (entget (car selectedobject))))))
		(if (member selectedobjecttype '("LINE" "LWPOLYLINE" "CIRCLE" "DIMENSION" "TEXT" "INSERT" "ARC"))
                           (setq selectedobjectlayer (cdr (assoc 8 selectedobject)))
		)
		(if selectedobjectlayer
			(progn
				(if     (setq layercolor (acad_truecolordlg 253 nil))
                                               (cond ((cddr layercolor)
                                                      (setq layercolor (cdaddr layercolor))
                                                      (setq colorbook (substr layercolor 1 (vl-string-position (ascii "$") layercolor 0 t)))
                                                      (setq colorbookcolor (substr layercolor (+ 2(vl-string-position (ascii "$") layercolor 0 t))))
                                                      (command-s "-Layer" "Color" "Colorbook" colorbook colorbookcolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " colorbookcolor "."))
                                                     )
                                                     ((cdr layercolor)
                                                      (setq layercolor (OLEtoRGB_color (cdadr layercolor)))
                                                      (setq layercolor (strcat (itoa (car layercolor))","(itoa (cadr layercolor))","(itoa (caddr layercolor))))
                                                      (command-s "-Layer" "Color" "Truecolor" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " layercolor "."))
                                                     )
                                                     ((setq layercolor (cdr (car layercolor)))
                                                      (command-s "-Layer" "Color" layercolor selectedobjectlayer "")
                                                      (princ (strcat "\nLayer: " selectedobjectlayer " changed to color: " (itoa layercolor) "."))
                                                     )
                                               )
					(princ "\nCancelled...")
				)
			)
			(princ "\nInvalid selection.")
		)
	)
	(princ "\nCancelled...")
)
(command "UNDO" "END")
(setvar "cmdecho" OLDCMDECHO)
(princ)
)

 

Other things I might do if this was my project: make a variant of OLEtoRGB_color that would return directly what you need ie "99,171,207" instead of (99 171 207) that you need to process further. Maybe a sub that accepts any color format and a layer as argument to make the color change accordingly. When different formats can be returned by a function like acad_truecolordlg (str or int in dotted pairs ((62 . 43) (420 . 13676676) (430 . "RAL CLASSIC$RAL 1001"))) using vl-princ-to-string can enable the removal of a bunch of lines of code. Less verification and unique way of processing. (vl-princ-to-string wathever instead of having to manipulate it in different ways depending of the nature. (itoa/rtos/as is if str)

 

As a last comment, when you have many if's it can be a challenge to follow the flow, and the code can spead over many many lines. They either can be nested or one after the other.

if (...) than do A

if A than do B

If B than do C

[b]Nested if:[/b]
(if (...)
 (if A
   (if B
     C)
 )
)
[b]Chain of if:[/b]
(if (...)
 A
)
(if A
   B
)
(if B
   C
)

[b]And alternative:[/b]
(and (...)
       A
       B
       C
)

...

@Ronjonp You have a (list missing!

Good eye .. fixed