Jump to content

lisp that change all color 13 to cyan color?

ctrlaltdel

By ctrlaltdel
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ctrlaltdel Enthusiast

ctrlaltdel

Posted
Posted

Greetings.

My drawings have entities in color 13 (not layer color) that need to change to cyan color. These entities embedded deep in different blocks and different nested levels and in different layers. Pls help with lisp that change all entities color 13 to cyan color.

Appreciate anyone assistance.

Link to comment
Share on other sites
broncos15 Proficient

broncos15

Posted
Posted

Here is something to get you started: 

(defun c:test (/ *error* ss cnt)
 (defun *error* (msg)
   (if (not
         (member msg '("Function cancelled" "quit / exit abort"))
       )
     (princ (strcat "\nError: " msg))
   )
   (princ)
 )
 (setq ss (ssget "_X")
       cnt 0)
 (repeat (sslength ss)
   (setq obj (vlax-ename->vla-object (ssname ss cnt)))
   ;;;Need to check if block is an xref or a layout and if so, ignore rest of code
   ;;;Use an if or statement or an if and statement to do this
   (if (= (vla-get-truecolor obj) colortype)
     (vla-put-truecolor obj desiredcolor)
     )
   (setq cnt (+ cnt 1))
   )
 )

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Not applicable for Xrefs, just for blocks nested to any depth... Maybe Lee could do it and for Xrefs, but it's good and this way it is...

 

(defun c:chcolor ( / process sc dc ss i ent blnlst enx )

 (vl-load-com)

 (defun process ( b / ent blnlst enx )
   (setq ent (tblobjname "BLOCK" b))
   (while (setq ent (entnext ent))
     (if (= (cdr (assoc 0 (entget ent))) "INSERT")
       (progn
         (if
           (and
             (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
             (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
           )
           (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
         )
         (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
           (progn
             (setq enx (entget ent))
             (foreach c dc
               (if (not (assoc (car c) enx))
                 (setq enx (append enx (list c)))
                 (setq enx (subst c (assoc (car c) enx) enx))
               )
             )
             (if (not (assoc 62 dc))
               (setq enx (vl-remove (assoc 62 enx) enx))
             )
             (if (not (assoc 420 dc))
               (setq enx (vl-remove (assoc 420 enx) enx))
             )
             (entupd (cdr (assoc -1 (entmod enx))))
           )
         )
       )
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
   )
   (if blnlst
     (foreach b blnlst
       (process b)
     )
   )
 )

 (alert "Choose source color to be changed...")
 (setq sc (acad_truecolordlg 256))
 (alert "Choose destination color to be changed into...")
 (setq dc (acad_truecolordlg 256))
 (if (not (equal (sssetfirst nil (ssget "_A")) '(nil nil)))
   (setq ss (ssget "_:L"))
 )
 (if ss
   (progn
     (repeat (setq i (sslength ss))
       (setq ent (ssname ss (setq i (1- i))))
       (if (= (cdr (assoc 0 (entget ent))) "INSERT")
         (progn
           (if
             (and
               (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
               (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
             )
             (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
           )
           (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
             (progn
               (setq enx (entget ent))
               (foreach c dc
                 (if (not (assoc (car c) enx))
                   (setq enx (append enx (list c)))
                   (setq enx (subst c (assoc (car c) enx) enx))
                 )
               )
               (if (not (assoc 62 dc))
                 (setq enx (vl-remove (assoc 62 enx) enx))
               )
               (if (not (assoc 420 dc))
                 (setq enx (vl-remove (assoc 420 enx) enx))
               )
               (entupd (cdr (assoc -1 (entmod enx))))
             )
           )
         )
         (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
           (progn
             (setq enx (entget ent))
             (foreach c dc
               (if (not (assoc (car c) enx))
                 (setq enx (append enx (list c)))
                 (setq enx (subst c (assoc (car c) enx) enx))
               )
             )
             (if (not (assoc 62 dc))
               (setq enx (vl-remove (assoc 62 enx) enx))
             )
             (if (not (assoc 420 dc))
               (setq enx (vl-remove (assoc 420 enx) enx))
             )
             (entupd (cdr (assoc -1 (entmod enx))))
           )
         )
       )
     )
     (if blnlst
       (foreach b blnlst
         (process b)
       )
     )
   )
 )
 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
 (princ)
)

M.R.

Regards...

Edited by marko_ribar
code modified to bypass error posted by OP I hope...
Link to comment
Share on other sites
Stefan BMR Proficient

Stefan BMR

Posted
Posted
Greetings.

My drawings have entities in color 13 (not layer color) that need to change to cyan color. These entities embedded deep in different blocks and different nested levels and in different layers. Pls help with lisp that change all entities color 13 to cyan color.

Appreciate anyone assistance.

This one?

Just replace '(2 50 51) with '(13) and 8 with 4.

Link to comment
Share on other sites
ctrlaltdel Enthusiast

ctrlaltdel

Posted
  • Author
Posted

Marko Sir, i encounter an error.

 

Command: CHCOLOR

; error: bad argument type: lentityp nil

After error, I regen then colors did change.

Xref not required. Best to not touch xref. Only dwg in that file.

 

My work buddy ask can select the block instead of whole drawing.

 

Thank you Sir

 

 

 

Not applicable for Xrefs, just for blocks nested to any depth... Maybe Lee could do it and for Xrefs, but it's good and this way it is...

 

(defun c:chcolor ( / process sc dc ss i ent blnlst enx )

 (vl-load-com)

 (defun process ( b / ent blnlst enx )
   (setq ent (tblobjname "BLOCK" b))
   (while (setq ent (entnext ent))
     (if (= (cdr (assoc 0 (entget ent))) "INSERT")
       (progn
         (if
           (and
             (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
             (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
           )
           (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
         )
         (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
           (progn
             (setq enx (entget ent))
             (foreach c dc
               (if (not (assoc (car c) enx))
                 (setq enx (append enx (list c)))
                 (setq enx (subst c (assoc (car c) enx) enx))
               )
             )
             (if (not (assoc 62 dc))
               (setq enx (vl-remove (assoc 62 enx) enx))
             )
             (if (not (assoc 420 dc))
               (setq enx (vl-remove (assoc 420 enx) enx))
             )
             (entupd (cdr (assoc -1 (entmod enx))))
           )
         )
       )
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
   )
   (if blnlst
     (foreach b blnlst
       (process b)
     )
   )
 )

 (alert "Choose source color to be changed...")
 (setq sc (acad_truecolordlg 256))
 (alert "Choose destination color to be changed into...")
 (setq dc (acad_truecolordlg 256))
 (setq ss (ssget "_X"))
 (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i))))
   (if (= (cdr (assoc 0 (entget ent))) "INSERT")
     (progn
       (if
         (and
           (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
           (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
         )
         (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
       )
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
     (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
       (progn
         (setq enx (entget ent))
         (foreach c dc
           (if (not (assoc (car c) enx))
             (setq enx (append enx (list c)))
             (setq enx (subst c (assoc (car c) enx) enx))
           )
         )
         (if (not (assoc 62 dc))
           (setq enx (vl-remove (assoc 62 enx) enx))
         )
         (if (not (assoc 420 dc))
           (setq enx (vl-remove (assoc 420 enx) enx))
         )
         (entupd (cdr (assoc -1 (entmod enx))))
       )
     )
   )
 )
 (if blnlst
   (foreach b blnlst
     (process b)
   )
 )
 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
 (princ)
)

M.R.

Regards...

Link to comment
Share on other sites
ctrlaltdel Enthusiast

ctrlaltdel

Posted
  • Author
Posted
This one?

Just replace '(2 50 51) with '(13) and 8 with 4.

 

Stefan Sir, it did change. Works good.

 

Work buddy ask can select blocks instead of changing whole drawing.

 

Thank you Sir

Link to comment
Share on other sites
Stefan BMR Proficient

Stefan BMR

Posted
Posted

Sure

 

(defun c:test ( / acdoc ss) (vl-load-com)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 (if
   (ssget ":L")
   (progn
     (vlax-for obj (setq ss (vla-get-activeselectionset acdoc))
       (change2cyan obj)
     )
     (vla-delete ss)
   )
 )
 (vla-regen acdoc acAllViewports)
 (princ)
 )

(defun change2cyan (obj)
 (cond
   ((eq (vla-get-objectname obj) "AcDbBlockReference")
    (vlax-for x (vla-item (vla-get-blocks acdoc) (vla-get-name obj))
      (change2cyan x))
    )
   ((= (vla-get-color obj) 13)
    (vla-put-color obj 4)
   )
 )
)

Link to comment
Share on other sites
ctrlaltdel Enthusiast

ctrlaltdel

Posted
  • Author
Posted

Thanks sir.

I have a last small request. Possible to have a feedback if changes were made & if not too much trouble, how many changes was made.

 

Sure

 

(defun c:test ( / acdoc ss) (vl-load-com)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 (if
   (ssget ":L")
   (progn
     (vlax-for obj (setq ss (vla-get-activeselectionset acdoc))
       (change2cyan obj)
     )
     (vla-delete ss)
   )
 )
 (vla-regen acdoc acAllViewports)
 (princ)
 )

(defun change2cyan (obj)
 (cond
   ((eq (vla-get-objectname obj) "AcDbBlockReference")
    (vlax-for x (vla-item (vla-get-blocks acdoc) (vla-get-name obj))
      (change2cyan x))
    )
   ((= (vla-get-color obj) 13)
    (vla-put-color obj 4)
   )
 )
)

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Hi, I've updated my firstly posted code to bypass error message you're receiving I hope... Test it and inform me... For Block Definition (not Reference - that's not possible - just single - CAD can update all of them with the same name - definition)...

 

(defun c:chcolor-blk ( / process sc dc ss n s i ent blnlst enx )

 (vl-load-com)

 (defun process ( b / ent blnlst enx )
   (setq ent (tblobjname "BLOCK" b))
   (while (setq ent (entnext ent))
     (if (= (cdr (assoc 0 (entget ent))) "INSERT")
       (progn
         (if
           (and
             (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
             (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
           )
           (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
         )
         (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
           (progn
             (setq enx (entget ent))
             (foreach c dc
               (if (not (assoc (car c) enx))
                 (setq enx (append enx (list c)))
                 (setq enx (subst c (assoc (car c) enx) enx))
               )
             )
             (if (not (assoc 62 dc))
               (setq enx (vl-remove (assoc 62 enx) enx))
             )
             (if (not (assoc 420 dc))
               (setq enx (vl-remove (assoc 420 enx) enx))
             )
             (entupd (cdr (assoc -1 (entmod enx))))
           )
         )
       )
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
   )
   (if blnlst
     (foreach b blnlst
       (process b)
     )
   )
 )

 (alert "Choose source color to be changed...")
 (setq sc (acad_truecolordlg 256))
 (alert "Choose destination color to be changed into...")
 (setq dc (acad_truecolordlg 256))
 (alert "Pick Block Reference on unlocked layer...")
 (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
 (while (or (not ss) (vlax-property-available-p (vlax-ename->vla-object (ssname ss 0)) 'Path))
   (prompt "\nMissed or picked entity not INSERT entity or picked INSERT entity belong to Xref or picked entity not on unlocked layer... Try again...")
   (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
 )
 (setq n (vla-get-effectivename (vlax-ename->vla-object (ssname ss 0))))
 (if (not (equal (sssetfirst nil (ssget "_A" '((0 . "INSERT")))) '(nil nil)))
   (setq s (ssget "_:L"))
 )
 (setq ss (ssadd))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
   (if (= n (vla-get-effectivename (vlax-ename->vla-object e)))
     (ssadd e ss)
   )
 )
 (if ss
   (progn
     (repeat (setq i (sslength ss))
       (setq ent (ssname ss (setq i (1- i))))
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
     (process n)
   )
 )
 (prompt "\nProcessed : ") (princ (sslength ss)) (prompt (strcat " block references with name of picked reference : \"" n "\"\n"))
 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
 (textscr)
 (princ)
)

Edited by marko_ribar
code modified - has info prompt also...
Link to comment
Share on other sites
ctrlaltdel Enthusiast

ctrlaltdel

Posted
  • Author
Posted

Thank you Sir. Now working without errors.

Would be happy if you allow this request:

- Requesting of the colors without dialog box popup. In command line will be enough. So i only key in 13 [enter] 4 [enter]

 

- able to select multiple objects including window fencing

 

- When command ends, the message on the command indicating how many blocks have change is fantastic but can the command editor not popup. Can the message include if there were any changes made

 

Thank you marko Sir

 

Hi, I've updated my firstly posted code to bypass error message you're receiving I hope... Test it and inform me... For Block Definition (not Reference - that's not possible - just single - CAD can update all of them with the same name - definition)...

 

(defun c:chcolor-blk ( / process sc dc ss n s i ent blnlst enx )

 (vl-load-com)

 (defun process ( b / ent blnlst enx )
   (setq ent (tblobjname "BLOCK" b))
   (while (setq ent (entnext ent))
     (if (= (cdr (assoc 0 (entget ent))) "INSERT")
       (progn
         (if
           (and
             (not (vlax-property-available-p (vlax-ename->vla-object ent) 'Path))
             (not (vl-position (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
           )
           (setq blnlst (cons (vla-get-effectivename (vlax-ename->vla-object ent)) blnlst))
         )
         (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
           (progn
             (setq enx (entget ent))
             (foreach c dc
               (if (not (assoc (car c) enx))
                 (setq enx (append enx (list c)))
                 (setq enx (subst c (assoc (car c) enx) enx))
               )
             )
             (if (not (assoc 62 dc))
               (setq enx (vl-remove (assoc 62 enx) enx))
             )
             (if (not (assoc 420 dc))
               (setq enx (vl-remove (assoc 420 enx) enx))
             )
             (entupd (cdr (assoc -1 (entmod enx))))
           )
         )
       )
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
   )
   (if blnlst
     (foreach b blnlst
       (process b)
     )
   )
 )

 (alert "Choose source color to be changed...")
 (setq sc (acad_truecolordlg 256))
 (alert "Choose destination color to be changed into...")
 (setq dc (acad_truecolordlg 256))
 (alert "Pick Block Reference on unlocked layer...")
 (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
 (while (or (not ss) (vlax-property-available-p (vlax-ename->vla-object (ssname ss 0)) 'Path))
   (prompt "\nMissed or picked entity not INSERT entity or picked INSERT entity belong to Xref or picked entity not on unlocked layer... Try again...")
   (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT"))))
 )
 (setq n (vla-get-effectivename (vlax-ename->vla-object (ssname ss 0))))
 (if (not (equal (sssetfirst nil (ssget "_A" '((0 . "INSERT")))) '(nil nil)))
   (setq s (ssget "_:L"))
 )
 (setq ss (ssadd))
 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
   (if (= n (vla-get-effectivename (vlax-ename->vla-object e)))
     (ssadd e ss)
   )
 )
 (if ss
   (progn
     (repeat (setq i (sslength ss))
       (setq ent (ssname ss (setq i (1- i))))
       (if (vl-every '(lambda ( x ) (vl-position x (entget ent))) sc)
         (progn
           (setq enx (entget ent))
           (foreach c dc
             (if (not (assoc (car c) enx))
               (setq enx (append enx (list c)))
               (setq enx (subst c (assoc (car c) enx) enx))
             )
           )
           (if (not (assoc 62 dc))
             (setq enx (vl-remove (assoc 62 enx) enx))
           )
           (if (not (assoc 420 dc))
             (setq enx (vl-remove (assoc 420 enx) enx))
           )
           (entupd (cdr (assoc -1 (entmod enx))))
         )
       )
     )
     (process n)
   )
 )
 (prompt "\nProcessed : ") (princ (sslength ss)) (prompt (strcat " block references with name of picked reference : \"" n "\"\n"))
 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
 (textscr)
 (princ)
)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...