strip text (mtext) color in mtext, leader and dimensions

[mruPRQUJ]

Hi, is it possible to create a lisp to strip text (mtext) color in mtext, leader, and dimensions? These text colors were forced to change "not by layer" in a text editor, not in a property. The attached lisp is your reference, thank you very much in advance.

[komondormrex · Accepted solution]

hey,

yep, it is possible. check the code below.

(defun c:decolor_m_text_leader_dim (/ m_list m_string coloring_found color_pos)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension")))))))
	(foreach m_ename m_list 
		(if (null (setq m_string (cdr (assoc 1 (entget m_ename)))))
				  (setq m_string (cdr (assoc 304 (entget m_ename))))
		)
		(setq coloring_found nil)
		(while (or 
					(setq color_pos (vl-string-search "\c" m_string))
					(setq color_pos (vl-string-search "\C" m_string))
			   )
					(setq m_string (strcat (substr m_string 1 (1- color_pos))
										   (substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
								   )
					      coloring_found (if (null coloring_found) t coloring_found) 
					)
		)
		(if coloring_found 
			(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring) 
					(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
					(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
			)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

[mruPRQUJ]

Hello, thank you very much for your quick response. I am busy with my work, I will test it later, thanks again.

[mruPRQUJ]

Hello, I tested it in my current working drawing, and it only partially works. I have created a new mtext, dimension and leader on the another drawing, it works perfectly. I think that the drawings have some problems, not related to your lisp. Also, I wonder if you can add the below to the lisp, 

change the hatch background color to none, please see the image below. Sorry about it, thanks a million. 🙂

[mruPRQUJ]

Thank you very much! 🙂

[le-tan-phuc]

I used these lines of code (for Mtext and Multileader) but an error occurred, please help Mr komondormrex
"Select objects: ; error: bad argument type: numberp: nil"

[komondormrex]

post a dwg sample that gives you the error.

[le-tan-phuc]

Here is the dwg !

I have searched for many solutions to execute with Vietnamese Mtext Multileader but they all have errors. If possible, please help me.

[komondormrex · Accepted solution]

check this one below

(defun c:decolor_m_text_leader_dim (/ m_list m_string coloring_found color_pos)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension")))))))
	(foreach m_ename m_list 
		(if (null (setq m_string (cdr (assoc 1 (entget m_ename)))))
				  (setq m_string (cdr (assoc 304 (entget m_ename))))
		)
		(setq coloring_found nil)
		(while (or 
					(setq color_pos (vl-string-search "\\c" m_string))
					(setq color_pos (vl-string-search "\\C" m_string))
			   )
			   (setq m_string (strcat (substr m_string 1 color_pos)
									  (substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
							  )
					 coloring_found (if (null coloring_found) t coloring_found) 
			   )
		)
		(if coloring_found 
			(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring) 
					(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
					(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
			)
		)
		(mapcar '(lambda (property) (vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object m_ename) property 0))) 
				'(backgroundfill textbackgroundfill textfill)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

[le-tan-phuc]

Awesome !
I finally found the perfect mtext strip code. Thank you very much Komondormrex, you saved me again ^^

[mruPRQUJ]

Great! It works perfect!

Could you please add the below into it?

Changing the hatch background color to none, please see the image below. thanks a million.

[komondormrex]

you mean yet another code? 

[mruPRQUJ]

Another code or add this code? Either one is good enough.

[le-tan-phuc · Accepted solution]

I found the code you need at this link

www.theswamp.org/index.php?topic=54244.msg588441#msg588441

1. (defun c:test (/ c a d)
2.   (vl-load-com)
3.   (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object))))
4.     (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a))))
5.   )
6.   (vlax-for b (vla-get-blocks d)
7.     (if (= 0 (vlax-get b 'isxref))
8.       (vlax-for o b
9.         (cond
10.           ((and (vlax-write-enabled-p o) (= (vla-get-objectname o) "AcDbHatch"))
11.            (or c (progn (setq c (vla-get-backgroundcolor o)) (vla-put-entitycolor c -939524096)))
12.            (vla-put-backgroundcolor o c)
13.           )
14.         )
15.       )
16.     )
17.   )
18.   (foreach l a (vlax-put l 'lock -1))
19.   (vla-regen d acallviewports)
20.   (princ)
21. )

[komondormrex · Accepted solution]

added to a new command

(defun c:decolor_mtldh (/ m_list m_string coloring_found color_pos is_hatch background_color_none)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq background_color_none (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))))
	(vla-put-entitycolor background_color_none -939524096) ; colormethod 200, r0g0b0
	(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension,hatch")))))))
	(foreach m_ename m_list
		(cond
		 	 ((setq m_string (cdr (assoc 1 (entget m_ename)))))
			 ((setq m_string (cdr (assoc 304 (entget m_ename)))))
			 (t (setq m_string "" is_hatch t))  
		)
		(setq coloring_found nil)
		(while (or
					(setq color_pos (vl-string-search "\\c" m_string))
					(setq color_pos (vl-string-search "\\C" m_string))
			   )
			   (setq m_string (strcat (substr m_string 1 color_pos)
									  (substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
							  )
					 coloring_found (if (null coloring_found) t coloring_found)
			   )
		)
		(if coloring_found
			(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring)
				(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
				(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
			)
		)
		(if is_hatch 
			(progn
				(vla-put-backgroundcolor (vlax-ename->vla-object m_ename) background_color_none)  
				(setq is_hatch nil)
			)
			(mapcar '(lambda (property) (vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object m_ename) property 0)))
					'(backgroundfill textbackgroundfill textfill)
			)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

[mruPRQUJ]

Great job! It works perfect! Many thanks for your great support!

[mruPRQUJ]

It works, but there is some limitation. Thank you for your help!