去除MTEXT格式函数

marting

(defun @UnFormat (Mtext Formats / All Format1 Format2 Text Str)
  ;;--------------------------------------------------
  ;; Primary function to perform the format stripping:
  ;; (04-20-03) John F. Uhden, Cadlantic
  ;; Arguments:
  ;;   Mtext   - the Mtext VLA-Object or Ename
  ;;   Formats - a string containing some or all of the following characters:
  ;;     A - Alignment
  ;;     C - Color
  ;;     F - Font
  ;;     H - Height
  ;;     L - Underscore
  ;;     O - Overscore
  ;;     P - Linefeed (Paragraph)
  ;;     Q - Obliquing
  ;;     S - Spacing (Stacking)
  ;;     T - Tracking
  ;;     W - Width
  ;;     ~ - Non-breaking Space
  ;;   Optional Formats -
  ;;     * - All formats
  ;; Returns:
  ;;   nil  - if not a valid Mtext object
  ;;   Text - the Mtext textstring with none, some, or all
  ;;          of the formatting removed, depending on what
  ;;          formats were present and what formats were
  ;;          specified for removal.
  ;;
  (cond
    ((= (type Mtext) 'VLA-Object))
    ((= (type Mtext) 'ENAME)
     (setq Mtext (vlax-ename->vla-object Mtext))
    )
    (1 (setq Mtext nil))
  )
  (and
    Mtext
    (= (vlax-get Mtext 'ObjectName) "AcDbMText")
    (= (type Formats) 'STR)
    (setq Formats (strcase Formats))
    (setq Mtext (vlax-get Mtext 'TextString))
    (setq Text "")
    (setq All T)
    (if        (= Formats "*")
      (setq Formats "S"
            Format1 "\\[LOP`~]"
            Format2 "\\[ACFHQTW]"
      )
      (progn
        (setq Format1 ""
              Format2 ""
        )
        (foreach item '("L" "O" "P" "~")
          (if (vl-string-search item Formats)
            (setq Format1 (strcat Format1 "`" item))
            (setq All nil)
          )
        )
        (if (= Format1 "")
          (setq Format1 nil)
          (setq Format1 (strcat "\\[" Format1 "]"))
        )
        (foreach item '("A" "C" "F" "H" "Q" "T" "W")
          (if (vl-string-search item Formats)
            (setq Format2 (strcat Format2 item))
            (setq All nil)
          )
        )
        (if (= Format2 "")
          (setq Format2 nil)
          (setq Format2 (strcat "\\[" Format2 "]"))
        )
        T
      )
    )
    (while (/= Mtext "")
      (cond
        ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
         (setq Mtext (substr Mtext 3)
               Text  (strcat Text Str)
         )
        )
        ((and All (wcmatch (substr Mtext 1 1) "[{}]"))
         (setq Mtext (substr Mtext 2))
        )
        ((and Format1 (wcmatch (strcase (substr Mtext 1 2)) Format1))
         (setq Mtext (substr Mtext 3))
        )
        ((and Format2 (wcmatch (strcase (substr Mtext 1 2)) Format2))
         (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
        )
        ((and (vl-string-search "S" Formats)
              (wcmatch (strcase (substr Mtext 1 2)) "\\S")
         )
         (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
               Text  (strcat Text (vl-string-translate "#^\\" "   " Str))
               Mtext (substr Mtext (+ 4 (strlen Str)))
         )
        )
        (1
         (setq Text  (strcat Text (substr Mtext 1 1))
               Mtext (substr Mtext 2)
         )
        )
      )
    )
  )
  Text
)

zhangq_cai1

啥也不说了，感谢楼主分享哇！

qqqincccken

谢谢提供,下载收藏试用了

马志刚

很好的工具