Shawn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; StripMtext v2.1 R15+ Copyright Steve Doman
sdo...@yahoo.com 8/25/01
;;
;; Program removes inline formatting from Mtext objects.
;;
;; Call by command:
;; Stripmtext
;;
;; Or call from lisp or script:
;; (StripMtext ss) where ss is a selection set
;;
;; Example to process all mtext objects in drawing from lisp
or script:
;; (StripMtext (ssget "x"))
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Main Function called by C:StripMtext or by your lisp or
script routine
;;
(defun StripMtext
( ss
/
; local vars
cnt
len
mtextobj
errobj
mod
; local subr
Instring
StripCode
StripStack
StripFormat
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following are supporting local functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;; Function: Instring
;;
;; Returns a list consisting of two strings:
;; the left and right side of 'str broken at
;; first thru last char of 'pat
;;
(defun Instring (str pat / l1 l2 pos)
(if (setq pos (vl-string-search pat str))
(progn
(setq l1 (strlen str) l2 (strlen pat))
(list (substr str 1 pos)(substr str (+ 1 pos l2)))
)
)
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;; Function: StripCode
;;
;; Cut 'string from 'code to ";"
;; Requires subr Instring
;;
(defun StripCode (string code / pat temp )
(setq pat (strcat "*" code "*;*"))
(while (wcmatch string pat)
(setq temp (Instring string code))
(setq string
(strcat
(car temp)
(cadr (Instring (cadr temp) ";"))
)
)
)
string
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;; Function: StripStack
;;
;; Removes stacked fraction code "\s" from 'string
;; Requires subr Instring
;;
(defun StripStack (string / temp )
(while (wcmatch string "*\\S*;*")
(setq
temp (Instring string "\\S")
string (strcat
(car temp)
(car (Instring (cadr temp) ";"))
(cadr (Instring (cadr temp) ";"))
)
)
)
string
)
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;; Function: StripFormat
;;
;; Given a mtext textstring,
;; returns string without formatting
;;
;; Requires subr Instring, StripCode, & StripStack
;;
(defun StripFormat (string /)
(foreach code '("\\F" "\\f" "\\C" "\\H" "\\Q" "\\T"
"\\W" "\\A")
(setq string (StripCode string code))
)
(foreach code '("\\{" "\\}" "\\L" "\\l" "\\O" "\\o"
"\\~" )
(while (vl-string-search code string)
(setq string (vl-string-subst "" code string))
)
)
(setq string (StripStack string ))
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;; Main Program
;;
;;
(if (< (read (getvar "acadver"))15.0)
(alert "Abort: StripMtext requires ACAD 2k or higher")
(progn
(setq cnt 0 mod 0 len (sslength ss))
(repeat len
(setq
mtextobj (vlax-ename->vla-object (ssname ss cnt))
cnt (1+ cnt)
)
(if (= "AcDbMText" (vlax-get-property mtextobj
"ObjectName"))
(progn
(setq errobj
(vl-catch-all-apply
'vlax-put-property
(list
mtextobj
"textstring"
(StripFormat (vlax-get-property mtextobj
"textstring"))
)
)
)
(if (not (vl-catch-all-error-p errobj))
(setq mod (1+ mod))
)
)
)
)
(princ
(strcat
"\nStripped: "
(itoa mod)
" mtext object"
(if (= 1 mod) " " "s ")
)
)
)
)
(princ)
);defun StripMtext
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; User Command: StripMtext
;;
;;
(defun c:StripMtext (/ ss space)
(if (< (read (getvar "acadver")) 15.0)
(alert "Abort: StripMtext requires ACAD 2k or higher")
(progn
(if
(and ;paper space is current
( = (getvar "cvport" ) 1)
( = (getvar "tilemode") 0)
)
(setq space 1) ;paperspace
(setq space 0) ;modelspace
)
(princ "\nStripMtext ")
(setq
ss (vl-catch-all-apply
'ssget
(list (list '(0 . "MTEXT")(cons 67 space)))
)
)
(if (not (vl-catch-all-error-p ss))
(stripmtext ss)
)
)
);if
(princ)
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(princ "\nStripMtext v2.1 loaded ")
(princ)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;