Mtext replace color
Hi Marcelo,
I have a deadline to meet today, so tonight or tomorrow, I'll see what I can do.
Henrique
Accepted solution
Hi Marcelo,
let's see if this is what you need...
(quickly written, and few tests)
(vl-load-com)
(defun c:ChangeTextColor (/ ch_str_color att attlst flag name 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
(or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
(if (and (princ "\n Select Text, Mtext or Attribute object to change its color: ")
(setq ss (ssget "_:L" '((0 . "MTEXT,TEXT,INSERT"))))
(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)
);; and
(vla-put-color obj new)
)
((= objn "AcDbBlockReference")
(cond ((and (= (vla-get-hasattributes obj) :vlax-true)
(setq attlst (vlax-invoke obj 'GetAttributes))
(progn (foreach att attlst
(if (= (vla-get-mtextattribute att) :vlax-true)
(setq flag T)
)
flag
)
)
);; and
(progn
(foreach att attlst
(if (= (vla-get-mtextattribute att) :vlax-false)
(if (= (vla-get-color att) old)
(vla-put-color att new)
);; if
(vla-put-textstring att (ch_str_color (vla-get-textstring att) old new))
);; if
);; foreach
(setq flag nil)
);; progn
)
((= (vla-get-hasattributes obj) :vlax-true)
(setq name (vla-get-effectivename obj))
(vlax-for blks (vla-get-blocks acdoc)
(if (and (= (vla-get-objectname blks) "AcDbBlockTableRecord")
(= (vla-get-name blks) name)
);; and
(progn
(vlax-for blk blks
(if (and (= (vla-get-objectname blk) "AcDbAttributeDefinition")
(= (vla-get-color blk) old)
);; and
(progn
(vla-put-color blk new)
(setq flag T)
);; progn
);; if
);; vlax-for
);; progn
);; if
);; vlax-for
(if flag
(progn
(command "_.attsync" "_N" name)
(setq flag nil)
);; progn
);; if
)
(T
(setq name (vla-get-effectivename obj))
(vlax-for blks (vla-get-blocks acdoc)
(if (and (= (vla-get-objectname blks) "AcDbBlockTableRecord")
(= (vla-get-name blks) name)
);; and
(progn
(vlax-for blk blks
(cond ((= (vla-get-objectname blk) "AcDbMText")
(vla-put-textstring blk (ch_str_color (vla-get-textstring blk) old new))
(setq flag T)
)
((and (= (vla-get-objectname blk) "AcDbText")
(= (vla-get-color blk) old)
);; and
(vla-put-color blk new)
(setq flag T)
)
);; cond
);; vlax-for
(if flag
(progn
(vla-regen acdoc 1)
(setq flag nil)
);; progn
);; if
);; progn
);; if
);; vlax-for
)
);; cond
)
);; cond
);; repeat
);; if
(princ)
)
Hope this helps,
Henrique
