;;;=======================[ Strip_Text.lsp ]=====================
;;; Author: Charles Alan Butler Copyright© 2005-2007
;;; Version: 2.3 Jan. 26, 2006
;;; Version: 3.0 Jun. 19, 2007
;;; Purpose: Strip format characters from text or mtext string
;;; Returns: A string
;;; Sub Routines: -None
;;; Arguments: A string variable to remove formats from & Flag string of formats to remove
;;; Format Flag:
;;; * Remove All Formats found
;;; A Alignment
;;; C Color
;;; F Font
;;; H Height
;;; L Underscore
;;; O Overscore
;;; P Linefeed (Paragraph) **** ??
;;; Q Obliquing
;;; S Spacing (Stacking)
;;; t Tabs
;;; T Tracking
;;; W Width
;;; ~ Non-breaking Space
;;; % Plain Text Formatting
;;
;;;======================================================================
(defun strip_text (str fmt / skipcnt ndx newlst char fmtcode lst_len
IS_MTEXT LST NEXTCHR PT TMP)
(if (or (/= (type fmt) 'Str) (= fmt "*") (= fmt ""))
(setq fmt (vl-string->list "AaCcFfHhLlOoPpQqSsTtQqWw~%"))
(setq fmt (vl-string->list fmt))
)
(setq ndx 0
;; "fmtcode" is a list of code flags that will end with ;
fmtcode
(vl-string->list "CcFfHhTQqWwAa") ;("\C" "\F" "\H" "\T" "\Q" "\W" "\A")
)
(if (/= str "") ; skip if empty text ""
(progn
(setq lst (vl-string->list str)
lst_len (length lst)
newlst '()
is_mtext nil ; true if mtext
)
(while (< ndx lst_len)
;; step through text and find FORMAT CHARACTERS
(setq char (nth ndx lst) ; Get next character
nextchr (nth (1+ ndx) lst)
skipcnt 0
)
(cond
((and (= char 123) (= nextchr 92)) ; "{" mtext code
(setq is_mtext t
skipcnt 1
)
)
((and (= char 125) is_mtext) ; "}"
(setq skipcnt 1)
)
((= char 37) ; code start with "%"
(if (null nextchr) ; true if % is last char in text
(setq skipcnt 1)
;; Dtext codes
(if (= nextchr 37) ; %% code found
(if (< 47 (nth (+ ndx 2) lst) 58) ; is a number
(if (vl-position 37 fmt)
;; number found so fmtcode %%nnn
;; convert the nnn to a character
(setq skipcnt 5
newlst (append newlst (list (atoi (strcat (chr (nth (+ ndx 2) lst))
(chr (nth (+ ndx 3) lst))
(chr (nth (+ ndx 4) lst))
)))))
;; keep the code in the string
(setq skipcnt 5
newlst (append newlst (list 37 37 (nth (+ ndx 2) lst)
(nth (+ ndx 3) lst)
(nth (+ ndx 4) lst)
)))
)
;; else letter code, so fmtcode %%p, %%d, %%c
;; CAB note - this code does not always exist in the string
;; it is used to create the character but the actual ascii code
;; is used in the string, not the case for %%c
(if (vl-position 37 fmt)
(setq skipcnt 3
newlst (append newlst (list (cond ((= (nth (+ ndx 2) lst) "p") 177)
((= (nth (+ ndx 2) lst) "d") 176)
((= (nth (+ ndx 2) lst) "c") 216)
((= (nth (+ ndx 2) lst) "%") 37)
))))
(setq skipcnt 3
newlst (append newlst (list 37 37 (nth (+ ndx 2) lst)
)))
)
) ; endif
) ; endif
) ; endif
) ; end cond (= char "%"))
((= char 92) ; code start with ""
;; This section processes mtext codes
(cond
;; Process Coded information
((null nextchr) ; true if \ is last char in text
(setq skipcnt 1)
) ; end cond 1
((member nextchr fmtcode) ; this code will end with ";"
;; fmtcode -> ("\C" "\F" "\H" "\T" "\Q" "\W" "\A"))
(while (/= (setq char (nth (+ skipcnt ndx) lst)) 59)
(setq skipcnt (1+ skipcnt))
)
(setq skipcnt (1+ skipcnt))
) ; end cond
;; found \U then get 7 character group
((= nextchr 85) (setq skipcnt (+ skipcnt 7)))
;; found \M then get 8 character group
((= nextchr 77) (setq skipcnt (+ skipcnt 8)))
;; found \P then replace with CR LF 13 10
;; debug do not add CR LF, just remobe \P
((= nextchr 80) ; "\P"
(if (vl-position 80 fmt)
(setq newlst (append newlst '(32))
;ndx (+ ndx 1)
skipcnt 2
)
)
) ; end cond
((= nextchr 123) ; "\{" normal brace
(setq ndx (+ ndx 1))
) ; end cond
((= nextchr 125) ; "\}" normal brace
(setq ndx (+ ndx 1))
) ; end cond
((= nextchr 126) ; "\~" non breaking space
(if (vl-position 126 fmt)
(setq newlst (append newlst '(32)) ; " "
skipcnt 2) ; end cond 9
)
)
;; 2 character group \L \l \O \o
((member nextchr '(76 108 79 111))
(setq skipcnt 2)
) ; end cond
;; Stacked text format as "[ top_txt / bot_txt ]"
((= nextchr 83) ; "\S"
(setq pt (1+ ndx)
tmp '()
)
(while
(not
(member
(setq tmp (nth (setq pt (1+ pt)) lst))
'(94 47 35) ; "^" "/" "#" seperator
)
)
(setq newlst (append newlst (list tmp)))
)
(setq newlst (append newlst '(47))) ; "/"
(while (/= (setq tmp (nth (setq pt (1+ pt)) lst)) 59) ; ";"
(setq newlst (append newlst (list tmp)))
)
(setq ndx pt
skipcnt (1+ skipcnt)
)
) ; end cond
) ; end cond stmt Process Coded information
) ; end cond (or (= char "\")
) ; end cond stmt
;; Skip format code characters
(if (zerop skipcnt) ; add char to string
(setq newlst (append newlst (list char))
ndx (+ ndx 1)
)
;; else skip some charactersPLOTTABS
(setq ndx (+ ndx skipcnt))
)
) ; end while Loop
) ; end progn
) ; endif
(vl-list->string newlst) ; return the stripped string
)
