Here is one i was working on.
Not fully tested & it strips all formatting.
;;;=======================[ Strip.lsp ]==================================
;;; Author: Charles Alan Butler Copyright© 2005
;;; Version: 1.0 June 22, 2005
;;; Purpose: Strip format characters from text or mtext
;;; Returns: A string
;;; Sub_Routines: -None
;;; Arguments: A string variable
;;;======================================================================
(defun strip (entstr / skipchr ndx newstring code nextchr fmtcode strlength)
(setq ndx 1
;; "fmtcode" is a list of code flags that will end with ;
fmtcode (list "\\C" "\\F" "\\H" "\\T" "\\Q" "\\W" "\\A")
)
(if (/= entstr nil) ; skip if empty text ""
(progn
(setq strlength (strlen entstr)
newstring ""
)
(while (<= ndx strlength)
;; step through text and find FORMATT CHARACTERS
(setq nextchr (substr entstr ndx 1) ; Get next character
skipchr 0)
(cond
((or (= nextchr "{") (= nextchr "}"))
(setq skipchr 1)
)
((or (= nextchr "\\") (= nextchr "%"))
;; process ctrl codes
;; This section processes groups codes
(setq code (strcase (substr entstr ndx 2)))
;; get next 2 characters
;; set to 2 because \\ is counted as one
(cond ;; Process Coded information
((= (strlen code) 1) ; true if \ or % is last char in text
(setq skipchr 2)
) ; end cond 1
((member code fmtcode) ; this code will end with ";"
(while (/= (setq nextchr (substr entstr (+ skipchr ndx) 1)) ";")
(setq skipchr (1+ skipchr))
) ; end while Loop
(setq skipchr (1+ skipchr))
) ; end cond 2
((= nextchr "%")
(if (= code "%%") ; code found
(if (distof (substr entstr (+ ndx 2) 1))
;;number found so fmtcode %%nnn
(setq skipchr 6)
;; else letter code, so fmtcode %%p
(setq skipchr 4)
) ; endif
;; else no %% codes so add the % char to list
) ; endif
) ; end cond 3
;; found \\U then get 7 character group
((= code "\\U") (setq skipchr 8)) ; end cond 4 ; CAB add
;; found \\M then get 8 character group
((= code "\\M") (setq skipchr 9)) ; end cond 5 ; CAB add
;; found \\P then replace with CR LF
((= code "\\P")
(setq newstring (strcat newstring (chr 13)(chr 10))
ndx (+ ndx 1)
skipchr 1)
) ; end cond 6
;; found \\ this is the normal brace, skip over \\
((= code "\\{") (setq ndx (+ ndx 1))) ; end cond 7
;; found \\ this is the normal brace, skip over \\
((= code "\\}") (setq ndx (+ ndx 1))) ; end cond 8
;; found \\ this is the non breaking space
((= code "\\~")
(setq newstring (strcat newstring " "))
(setq skipchr 2) ; end cond 9
)
;; found \\\\ it is one \
((= code "\\\\")
(setq newstring (strcat newstring "\\")
ndx (+ ndx 2))
) ; end cond 10
;; Stacked text format as "[ top_txt / bot_txt ]"
((= code "\\S")
(setq pt (1+ ndx)
tmp ""
newstring (strcat newstring "[")
)
(while
(not
(member
(setq tmp (substr entstr (setq pt (1+ pt)) 1))
'("^" "/" "#")))
(setq newstring (strcat newstring tmp))
)
(setq newstring (strcat newstring "/"))
(while (/= (setq tmp (substr entstr (setq pt (1+ pt)) 1)) ";")
(setq newstring (strcat newstring tmp))
)
(setq newstring (strcat newstring "]")
ndx pt
skipchr (1+ skipchr)
)
) ; end cond 11
;; found \\ then get 2 character group \L \l \O \o
((= nextchr "\\") (setq skipchr 3)) ; end cond 12
)
;; end cond Process Coded information
) ; end cond (or (= NextChr "\\") (= NextChr "%"))
) ; end cond
(if (zerop skipchr) ; add char to string
(setq newstring (strcat newstring (substr entstr ndx 1))
ndx (+ ndx 1))
;; else skip some characters
(setq ndx (+ ndx skipchr))
)
) ; end while Loop
) ; end progn
) ; endif
newstring ; return the stripped string
) ; end defun
;;;======================================================================
