Mtext Replace Color (from a True Color value to another value)

Mtext Replace Color (from a True Color value to another value)

Jaxom26
Contributor Contributor
2,677 Views
9 Replies
Message 1 of 10

Mtext Replace Color (from a True Color value to another value)

Jaxom26
Contributor
Contributor

I'm trying to change MTEXT and Attributes even within Blocks from a True Color Value 0,0,0 to another value, either another True Color Value or one of the AuotCAD standard 1 - 256 colors.

 

I found this routine below that allows the user to input a color to change and then input a color to change that color to, but I don't know how to modify it or if it is even possible to modify it for True Colors.

 

(vl-load-com)
(defun c:ChangeTextColor (/ ch_str_color attlst new i obj objn old ss)

  (defun ch_str_color (str old new /)
    (while (vl-string-search (strcat "\\C" (itoa old) ";") str)
      (setq str (vl-string-subst
                  (strcat "\\C" (itoa new) ";")
                  (strcat "\\C" (itoa old) ";")
                  str
                );vl
      );setq str
    );while
    str
  );;ch_str_color

  (if (and (princ "\n Select Text, Mtext or Attribute object to change its color: ")
           (setq ss (ssget "_:L"
                           '((-4 . "<OR")
                             (0 . "MTEXT,TEXT")
                             (-4 . "<AND")
                             (0 . "INSERT")
                             (66 . 1)
                             (-4 . "AND>")
                             (-4 . "OR>")
                            )
                    )
           )
           (setq old (getint "\n Enter the old color number: "))
           (<= 0 old 256)
           (setq new (getint "\n Enter the new color number: "))
           (<= 0 new 256)
      );and
    (repeat (setq i (sslength ss))
      (setq obj  (vlax-ename->vla-object (ssname ss (setq i (1- i))))
            objn (vla-get-objectname obj)
      );setq
      (cond ((= objn "AcDbMText")
             (vla-put-textstring obj (ch_str_color (vla-get-textstring obj) old new))
            )
            ((and (= objn "AcDbText")
                  (= (vla-get-color obj) old)
             )
             (vla-put-color obj new)
            )
            ((= objn "AcDbBlockReference")
             (setq attlst (vlax-invoke obj 'GetAttributes))
             (foreach att attlst
               (if (= (vla-get-mtextattribute att) :vlax-false)
                 (if (= (vla-get-color att) old)
                   (vla-put-color att new)
                 )
                 (vla-put-textstring att (ch_str_color (vla-get-textstring att) old new))
               )
             )
            )
      );; cond
    );repeat
  );if and
  (princ)
)

Here's a link to the forum post where I pulled this lisp routine code from.

Mtext replace color link

0 Likes
2,678 Views
9 Replies
Replies (9)
Message 2 of 10

CodeDing
Advisor
Advisor

@Jaxom26 ,

 

You can update the color property to either an integer (for index colors) or a string (for true colors). Does that help?

(setq e (car (entsel "\nSelect MText: ")))
(setpropertyvalue e "Color" 1);<-- sets color to red (index color)
(setpropertyvalue e "Color" "255,255,255");<-- sets color to white (true color)

Best,

~DD

0 Likes
Message 3 of 10

Jaxom26
Contributor
Contributor

Just to confirm, what lines do I need to replace with the code you listed?

0 Likes
Message 4 of 10

dlanorh
Advisor
Advisor

Your lisp needs to be completely re-written to handle true colours as it currently only deals with the color property which is an interger from 0 (byblock)->256 (bylayer).

 

I also doesn't change the color of MText but instead overrides the mtext color property with an "in string" color. 

I am not one of the robots you're looking for

0 Likes
Message 5 of 10

Jaxom26
Contributor
Contributor

Not sure I have the knowledge to re-write this routine since I pulled it off of an old forum post. I'll try posting there and see if I get something.

0 Likes
Message 6 of 10

CodeDing
Advisor
Advisor

@Jaxom26 ,

 

I think this should accomplish what you're looking for.

(defun c:CTC ( / e ans typ)
;Change Text Color
  (if (and (setq e (car (nentsel "\nSelect MText, Text, or Attribute: ")))
           (member (cdr (assoc 0 (entget e))) '("MTEXT" "TEXT" "ATTRIB")))
    (progn
      (while (not ans)
        (setq ans (getstring "\nEnter Index color integer, or True color string: "))
        (setq typ (type (read ans)))
        (if (not (or (eq 'INT typ)
                     (and (wcmatch ans "#`,*#*`,*#,##`,*#*`,*#,###`,*#*`,*#")
                          (wcmatch ans "#*`,#`,*#,#*`,##`,*#,#*`,###`,*#")
                          (wcmatch ans "#*`,*#*`,#,#*`,*#*`,##,#*`,*#*`,###"))))
          (setq ans (prompt "...invalid entry."))
        );if
      );while
      (setpropertyvalue e "Color" (if (eq 'INT typ) (atoi ans) ans))
      (prompt "\nCTC Complete.")
    );progn
  ;else
    (prompt "...invalid entity selected.")
  );if
  (princ)
);defun

Best,

~DD

0 Likes
Message 7 of 10

Jaxom26
Contributor
Contributor

It doesn't seem to work, for one I have a drawing where someone put hundreds of pieces of MText in the drawing that have the font color changed to a True Color. Many of them are also embeded in blocks and some blocks are embedded within blocks. The lisp I posted works perfectly except it doesn't work with True Colors.

0 Likes
Message 8 of 10

dlanorh
Advisor
Advisor
Post a sample drawing containing the a few of each of the items so those trying to help have something to reference and test on.

I am not one of the robots you're looking for

0 Likes
Message 9 of 10

Jaxom26
Contributor
Contributor

I attached a ZIP file of the drawing I'm trying to clean up, it might be hard to see, but all over the drawing are little blocks containing MTEXT as well as pieces of MTEXT that are black. Some Blocks are nested within other blocks which makes it even more challenging. If you have your model space set to a black background it can be hard to see all the text.

 

I have several Lisp routines that can get the drawing to 80% and I can finish off the rest manually, but I feel there has to be a better way since I'm given an updated racking plan every few weeks.

0 Likes
Message 10 of 10

3wood
Advisor
Advisor

I have attached a fixed file here. 

You can try CHZ20 to get it done in one go. I used the settings below.

Also attached the color matching file to be used in the add-on. You can modify it yourself to suit.

Capture.PNG

0 Likes