StripMtext.lsp

mail@pastecode.io avatar
unknown
lisp
2 years ago
1.8 kB
4
Indexable
Never
(defun c:StpMtext (/ ss ent1 ent2 tstr1 tstr2)
; Strips Mtext of certain formating

(command "_.undo" "_end")
(command "_.undo" "_group")
(if (setq ss (ssget "x" '((0 . "MTEXT"))))
	(while (/= (sslength ss) 0)
		(setq ent1 (ssname ss 0))
		(setq ent2 (vlax-ename->vla-object ent1))
		(setq tstr1 (vlax-get ent2 'TextString))
		(setq tstr2 (StripString tstr1))
		(vlax-put ent2 'TextString tstr2)
		(ssdel ent1 ss)
	); while
); if
(command "_.undo" "_end")
(princ)
)

;-------------------------------------

(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

(setq cnt1 1)
	(while 
	  (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
		(if (= cstr1 "\\")
			(progn
				(setq cstr2 (substr String 2 1))
		
					(if (member (strcase cstr2) '("C" "F" "H" "W"))
						(progn
							(while (/= (substr String cnt1 1) ";")
								(setq cnt1 (1+ cnt1))
							); while
     
						 (setq String (substr String (1+ cnt1) (strlen String)))
						 (setq cnt1 1)
						); progn
						
						(progn
							 (if nString
								  (setq nString (strcat nString (substr String 1 1)))
								  (setq nString (substr String 1 1))
							 ); if
							 (setq String (substr String 2 (strlen String)))
						); progn
					); if
			); progn
			
		  (progn
			   (if nString
					(setq nString (strcat nString (substr String 1 1)))
					(setq nString (substr String 1 1))
			   ); if
			   (setq String (substr String 2 (strlen String)))
		  ); progn
		); if
	); while
	
	(setq tstr1 (vl-string->list nString))
	(if (and (not (member 92 tstr1)) (member 123 tstr1))
		(setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
	); if
	(vl-list->string tstr1)
)