+ Reply to Thread
Results 1 to 6 of 6
  1. #1
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    168

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

    Registered forum members do not see this ad.

    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?

    Code:
    (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)
    Last edited by Aftertouch; 8th Sep 2017 at 12:55 pm.

  2. #2
    Senior Member Jef!'s Avatar
    Using
    AutoCAD 2008
    Join Date
    Sep 2010
    Posts
    228

    Default

    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.

    Code:
    (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!
    Different goal also quite often means different path...

  3. #3
    Senior Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    168

    Default

    Hey Jef, thanks for the feedback.
    About the assoc 410 part:
    Code:
    			(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).

  4. #4
    Senior Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    392

    Default

    You could also check the length of the nentsel list .. if it's nested, the length will be greater than two.
    Code:
    (setq e (nentsel))
    (cond ((caddr e) (car (last e)))
          ((car e))
    )
    Here's an alternative way to structure the code too:
    Code:
    (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")
      )
    )
    Last edited by ronjonp; 13th Sep 2017 at 04:11 pm.

  5. #5
    Senior Member Jef!'s Avatar
    Using
    AutoCAD 2008
    Join Date
    Sep 2010
    Posts
    228

    Default

    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]
    )
    Code:
    (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
    Code:
    Nested if:
    (if (...)
      (if A
        (if B
          C)
      )
    )
    Chain of if:
    (if (...)
      A
    )
    (if A
        B
    )
    (if B
        C
    )
    
    And alternative:
    (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! :)
    Different goal also quite often means different path...

  6. #6
    Senior Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    392

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by Jef! View Post
    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.


    Code:
    (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
    Code:
    Nested if:
    (if (...)
      (if A
        (if B
          C)
      )
    )
    Chain of if:
    (if (...)
      A
    )
    (if A
        B
    )
    (if B
        C
    )
    
    And alternative:
    (and (...)
            A
            B
            C
    )
    ...
    @Ronjonp You have a (list missing!
    Good eye .. fixed

Similar Threads

  1. lisp that change all color 13 to cyan color?
    By ctrlaltdel in forum AutoLISP, Visual LISP & DCL
    Replies: 9
    Last Post: 8th Jul 2016, 01:39 am
  2. Using VBA to change an object's color
    By abraxus in forum .NET, ObjectARX & VBA
    Replies: 3
    Last Post: 21st Sep 2013, 07:59 am
  3. Replies: 15
    Last Post: 16th Jul 2013, 05:20 pm
  4. How to change color of 3D object?
    By Mason Dixon in forum AutoCAD 3D Modelling & Rendering
    Replies: 1
    Last Post: 15th Apr 2011, 07:44 pm
  5. Change Object Color
    By fade2blackened in forum AutoLISP, Visual LISP & DCL
    Replies: 9
    Last Post: 18th Jan 2009, 02:09 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts