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

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

mruPRQUJ
Advocate Advocate
2,563 Views
16 Replies
Message 1 of 17

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

mruPRQUJ
Advocate
Advocate

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.

0 Likes
Accepted solutions (4)
2,564 Views
16 Replies
Replies (16)
Message 2 of 17

komondormrex
Mentor
Mentor
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)
)

 

 

Message 3 of 17

mruPRQUJ
Advocate
Advocate

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

0 Likes
Message 4 of 17

mruPRQUJ
Advocate
Advocate

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_0-1682828604188.png

 

0 Likes
Message 5 of 17

mruPRQUJ
Advocate
Advocate

Thank you very much! 🙂

0 Likes
Message 6 of 17

le-tan-phuc
Enthusiast
Enthusiast

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"
0 Likes
Message 7 of 17

komondormrex
Mentor
Mentor

post a dwg sample that gives you the error.

 

komondormrex_0-1714977820612.gif

 

0 Likes
Message 8 of 17

le-tan-phuc
Enthusiast
Enthusiast

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.

0 Likes
Message 9 of 17

komondormrex
Mentor
Mentor
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)
)
Message 10 of 17

le-tan-phuc
Enthusiast
Enthusiast

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

0 Likes
Message 11 of 17

mruPRQUJ
Advocate
Advocate

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.

mruPRQUJ_0-1715020972679.png

 

 

 

0 Likes
Message 12 of 17

komondormrex
Mentor
Mentor

you mean yet another code? 

Message 13 of 17

mruPRQUJ
Advocate
Advocate

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

0 Likes
Message 14 of 17

le-tan-phuc
Enthusiast
Enthusiast
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.     (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a))))
  3.   )
  4.     (if (= 0 (vlax-get b 'isxref))
  5.       (vlax-for o b
  6.         (cond
  7.           ((and (vlax-write-enabled-p o) (= (vla-get-objectname o) "AcDbHatch"))
  8.            (or c (progn (setq c (vla-get-backgroundcolor o)) (vla-put-entitycolor c -939524096)))
  9.            (vla-put-backgroundcolor o c)
  10.           )
  11.         )
  12.       )
  13.     )
  14.   )
  15.   (foreach l a (vlax-put l 'lock -1))
  16.   (vla-regen d acallviewports)
  17.   (princ)
  18. )
Message 15 of 17

komondormrex
Mentor
Mentor
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)
)

 

Message 16 of 17

mruPRQUJ
Advocate
Advocate

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

0 Likes
Message 17 of 17

mruPRQUJ
Advocate
Advocate

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

0 Likes