LISP to change object colors on a drawing

[Xiphos]

Apologies if something similar has been requested, but I have searched and have not quite come up with what I am attempting to accomplish.  I have extremely limited LISP experience, and seek the experts help.

 

My Autocad version is AutoCAD Mechanical 2016.

 

Problem:  I would like the LISP to find all objects (OK to exclude blocks, tables, xrefs, etc) that are a color (13 in total) and change to a predetermined color, then output how many objects were changed.  Output should be a message in the command line. Won't need user input but it would just be nice to see "0 Objects changed" if it didn't find any.  Colors to find are 1,2,3,4,5,6,7,8,9,40,41,80,140.  They should go to color 151.  I would prefer if the LISP only changed object colors, and left layer colors alone.

 

The closest code I've found is below.  I have attempted to modify it to my specifications, but have failed to get it to work, and now I broke it.  Haha.  This code also ignored objects that had something other than 'ByLayer' color assignments, so I really need the LISP to look at the obj color, instead of layers.  The drawings I will be working with might have many different types of color assignments.

(defun c:104C (/ doc *error* ColorTo104 lst s)
  ;; Author : Tharwat AL Shoufi        ;;
  ;; www.CadTutor.com 11.Oct.2013    ;;
  (or doc
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (defun *error* (u)
    (if lst
      (foreach it lst
        (vla-put-lock (vla-item (vla-get-layers doc) it) :vlax-true)
      )
    )
    (princ "\n *Cancel*")
  )
  (defun ColorTo104 (ent)
    (if (eq 3 (vla-get-color ent))
      (vla-put-color ent 104)
    )
  )
  (vlax-for l (vla-get-layers doc)
    (ColorTo104 l)
    (if (eq :vlax-true (vla-get-lock l))
      (progn
        (vla-put-lock l :vlax-false)
        (setq lst (cons (vla-get-name l) lst))
      )
    )
  )
  (vla-startUndomark doc)
  (vlax-for b (vla-get-blocks doc)
    (if (and (eq :vlax-false (vla-get-IsXref b))
             (eq :vlax-false (vla-get-IsLayout b))
        )
      (vlax-for x b
        (ColorTo104 x)
      )
    )
  )
  (if (ssget "_X"
             '(
               (-4 . "<OR")
               (-4 . "<AND")
               (62 . 3)
               (-4 . "AND>")
               (-4 . "<AND")
               (0 . "INSERT")
               (66 . 1)
               (-4 . "AND>")
               (-4 . "OR>")
              )
      )
    (progn
      (vlax-for e (setq s (vla-get-ActiveSelectionSet doc))
        (if (and (eq (vla-get-objectname e) "AcDbBlockReference")
                 (eq :vlax-true (vla-get-hasattributes e))
            )
          (foreach att (vlax-invoke e 'GetAttributes)
            (ColorTo104 att)
          )
          (ColorTo104 e)
        )
      )
      (vla-delete s)
    )
  )
  (if lst
    (foreach u lst
      (vla-put-lock (vla-item (vla-get-layers doc) u) :vlax-true)
    )
  )
  (vla-regen doc AcActiveViewport)
  (vla-EndUndoMark doc)
  (princ)
)
(vl-load-com)

Thank you in advance for your time.  It is greatly appreciated!

[dlanorh]

This should get close to what you want. Briefly tested

 

Unlocks all layers and relocks on exit/error. Won't process blocks/xrefs or tables.

 

(defun rh:getlocked ( doc / lst)
  (vlax-for lyr (vla-get-layers doc)
    (cond ( (= :vlax-true (vlax-get-property lyr 'lock))
            (setq lst (cons (list lyr) lst))
            (vlax-put-property lyr 'lock :vlax-false)
          )
    );end_cond
  );end_for
  (if lst (setq lst (reverse lst)) (setq lst nil))
);end_defun

(vl-load-com)

(defun c:c151 (/ *error* c_doc llst ss cnt ent el typ obj ocnt)

  (defun *error* ( msg )
    (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) llst)
    (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))
        llst (rh:getlocked c_doc)
	ocnt 0
        ss (ssget "_X" '((-4 . "<NOT") (62 . 256) (-4 . "NOT>")))
  )

  (cond (ss 
          (repeat (setq cnt (sslength ss))
            (setq el (entget (setq ent (ssname ss (setq cnt (1- cnt)))))
                  typ (cdr (assoc 0 el))
            )
            (cond ( (not (member typ (list "INSERT" "TABLE")))
                    (setq obj (vlax-ename->vla-object ent))
                    (cond ( (vl-position (vlax-get obj 'color) (list 1 2 3 4 5 6 7 8 9 40 41 80 140)) (vlax-put obj 'color 151) (setq ocnt (1+ ocnt))))
                  )
            );end_cond
          );end_repeat
          (princ (strcat "\n" (itoa ocnt) " Objects Changed"))
        )
        (t (princ (strcat "\n0 Objects Changed")))
  );end_cond

  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) llst)
  (princ)
)

 

[Xiphos]

Thank you so much!  Everything works great, except for color '1' is 'red' and for some reason, that is not changing

[dlanorh]

Have retested and this works with red lines where the color has been overridden. This will not work with red lines on layers where the color is red as there will be no color property (default bylayer) or the color will be bylayer (256).

 

[Xiphos]

I think I have made a mistake.  Could we add changing the layer color also? if it is part of the list.  

[dlanorh]

So ANY layer that has a color (1 2 3 4 5 6 7 8 9 40 41 80 140) should be changed or only color 1? Remember that this will change the color of all items on that layer including any Blocks, XRefs and Tables.

[Xiphos]

Yes, please, I realize now that I need objects and layers to change, because some of the objects are set to 'bylayer' color.  Thanks! Sorry!

[dlanorh]

OK. Try this

 

(defun rh:getlocked ( doc / lst)
  (vlax-for lyr (vla-get-layers doc)
    (cond ( (= :vlax-true (vlax-get-property lyr 'lock))
            (setq lst (cons (list lyr) lst))
            (vlax-put-property lyr 'lock :vlax-false)
          )
    );end_cond
  );end_for
  (if lst (setq lst (reverse lst)) (setq lst nil))
);end_defun

(vl-load-com)

(defun c:c151 (/ *error* clst c_doc llst ocnt ss cnt ent el typ obj)

  (defun *error* ( msg )
    (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) llst)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq clst (list 1 2 3 4 5 6 7 8 9 40 41 80 140)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        llst (rh:getlocked c_doc)
        ocnt 0
  );end_setq

  (vlax-for lyr (vla-get-layers c_doc) 
    (cond ( (vl-position (vlax-get lyr 'color) clst) (vlax-put lyr 'color 151) (setq ocnt (1+ ocnt))))
    (setq lylst (cons (list (vlax-get lyr 'name) (vlax-get lyr 'color)) lylst))
  );end_for

  (princ (strcat "\n" (itoa ocnt) "Layer Colors Changed"))

  (setq ocnt 0
        ss (ssget "_X" '((-4 . "<NOT") (62 . 256) (-4 . "NOT>")))
  );end_setq

  (cond (ss 
          (repeat (setq cnt (sslength ss))
            (setq el (entget (setq ent (ssname ss (setq cnt (1- cnt)))))
                  typ (cdr (assoc 0 el))
                  lyr (cdr (assoc 8 el))
            );end_setq
            (cond ( (not (member typ (list "INSERT" "TABLE")))
                    (setq obj (vlax-ename->vla-object ent))
                    (cond ( (vl-position (vlax-get obj 'color) clst)
                            (if (= (cadr (assoc lyr lylst)) 151) (vlax-put obj 'color 256) (vlax-put obj 'color 151))
                            (setq ocnt (1+ ocnt))
                          )
                    );end_cond
                  )
            );end_cond
          );end_repeat
          (princ (strcat "\n" (itoa ocnt) " Objects Changed"))
        )
        (t (princ (strcat "\n0 Objects Changed")))
  );end_cond

  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) llst)
  (princ)
);end_defun

 

Points to note :

 

1. The default color for layer "0" is 7, so this will change layer "0"'s color. If you don't want this let me know and I can exempt it or any other layer that you don't want changing.

 

2. If objects that are not color "bylayer" and should be changed, are on a layer whose color has been changed; these objects are set to bylayer. This is to avoid individual objects having an object color the same as its layer color.  Again, any problems the let me know.

 

[Xiphos]

dlanorh,

 

This has helped me greatly! I appreciate it!  I am still working out exactly how the workflow will happen now I'll let you know if I have any other issues!  Thanks again!