多行文字去格式控制符后粘贴到剪贴板和命令行

striver

;多行文字去格式控制符后粘贴到剪贴板和命令行

;参考和修改了部分已有代码

(defun C:ztt ( / TextObj ss textStr)
  (setq TextObj nil)
  (setq ss (cadr (ssgetfirst)))
  (if ss
    (if (= 1 (sslength ss))
      (progn
                                (sssetfirst nil nil)
        (setq TextObj (ssname ss 0))
      )        
    )
  )
  (if (not TextObj) (setq TextObj (car (entsel "\n选择源文字：\n"))))
  
  (if (not TextObj) (exit))
  (if (not (wcmatch (cdr(assoc 0 (entget TextObj))) "*TEXT")) (exit))
  (redraw TextObj 3)
  
  (setq textStr (vla-get-textstring (vlax-ename->vla-object TextObj)))
  (if (= (cdr(assoc 0 (entget TextObj))) "MTEXT")
    (setq textStr (mtext2text01 textStr))
  )
  
  (SET-CLIP-STRING textStr)
  (princ textStr)
  (princ)
)

;提取多行文字,去除无用格式符号
(defun mtext2text01(MTextString / regex s)
  (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
  (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
  (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
  (setq s MTextString)
        ;替换\\字符
  (vlax-put-property regex "Pattern" "\\\\\\\\")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
        ;替换\{字符
  (vlax-put-property regex "Pattern" "\\\\{")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
        ;替换\}字符
  (vlax-put-property regex "Pattern" "\\\\}")
  (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))

        ;删除自动编号
  (vlax-put-property regex "Pattern" "\\\\px(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
          ;删除水平制表符
  (vlax-put-property regex "Pattern" "\\x09")
  (setq s(vlax-invoke-method  regex "Replace" s ""))

        ;删除段落缩进格式
  (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除制表符格式
  (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除堆迭格式
  (vlax-put-property regex "Pattern" "\\\\S(\\^)?(.[^^|^;]*)(\\^)?;")
  (setq s(vlax-invoke-method  regex "Replace" s "$2"))
        ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
  (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除下划线、删除线格式
  (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除不间断空格格式
  (vlax-put-property regex "Pattern" "\\\\~")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;换行符格式，替换为\n
  (vlax-put-property regex "Pattern" "\\\\P")
  (setq s(vlax-invoke-method  regex "Replace" s "\n"))
        ;删除换行符格式(针对Shift+Enter格式)
;;;  (vlax-put-property regex "Pattern" "\n")
;;;  (setq s(vlax-invoke-method  regex "Replace" s ""))
        ;删除{}
  (vlax-put-property regex "Pattern" "({|})")
  (setq s(vlax-invoke-method  regex "Replace" s ""))
        
        ;替换回\\,\{,\}字符
  (vlax-put-property regex "Pattern" "\\x01")
  (setq s(vlax-invoke-method  regex "Replace" s "\\"))
  (vlax-put-property regex "Pattern" "\\x02")
  (setq s(vlax-invoke-method  regex "Replace" s "{"))
  (vlax-put-property regex "Pattern" "\\x03")
  (setq s(vlax-invoke-method  regex "Replace" s "}"))
        
  (vlax-release-object regex)
  s
)

;;;功能：向系统剪贴板写入文字                                       *
(defun SET-CLIP-STRING (STR666 / HTML666 RESULT666)
        (and (= (type STR666) 'STR)
                (setq HTML666 (vlax-create-object "htmlfile"))
                (setq RESULT666 (vlax-invoke
                                                                                        (vlax-get (vlax-get HTML666 'PARENTWINDOW)
                                                                                                'CLIPBOARDDATA
                                                                                        )
                                                                                        'SETDATA
                                                                                        "Text"
                                                                                        STR666
                                                                                )
                )
                (vlax-release-object HTML666)
        )
)

kmliro_2017

谢谢分享！！！！！

kmliro_2017

谢谢分享！！！！！

kmliro_2017

谢谢分享 ！！！！！

kmliro_2017

谢谢分享 ！！！！！

XDSoft

kmliro_2017 发表于 2023-12-28 08:08
谢谢分享 ！！！！！

XDRX API 现在有函数 xdrx-mtext-fragments, 可以直接得到MTEXT的格式信息

Command: (xdrx-mtext-fragments (entlast))
((("kTextString" "faff") ("kLocation" (70314.2 20465.8 0.0)) ("kCapsHeight" 2.5) ("kWidthFactor" 1.0) ("kColorIndex" 256) ("kColor" (0 0 0)) ("kNormal" (0.0 0.0 1.0)) ("kDirection" (1.0 0.0 0.0)) ("kExtents" (4.97442 2.58356)) ("kFont" nil) ("kBigFont" nil) ("kFontName" "Arial") ("kOblique" 0.0) ("kItalic" 0) ("kBold" 0) ("kStackTop" 0) ("kStackBottom" 0) ("kStackThrough" 0) ("kTrackingFactor" 1.0) ("kUnerLined" 0) ("kOverLined" 0) ("kOverPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kUnderPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kStrikePoints" (0.0 0.0 0.0) (0.0 0.0 0.0))) (("kTextString" "fsf") ("kLocation" (70314.0 20461.6 0.0)) ("kCapsHeight" 2.5) ("kWidthFactor" 1.0) ("kColorIndex" 32) ("kColor" (205 105 40)) ("kNormal" (0.0 0.0 1.0)) ("kDirection" (1.0 0.0 0.0)) ("kExtents" (4.74932 2.58527)) ("kFont" nil) ("kBigFont" nil) ("kFontName" "Arial") ("kOblique" 0.0) ("kItalic" 1) ("kBold" 1) ("kStackTop" 0) ("kStackBottom" 0) ("kStackThrough" 0) ("kTrackingFactor" 1.0) ("kUnerLined" 0) ("kOverLined" 0) ("kOverPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kUnderPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kStrikePoints" (0.0 0.0 0.0) (0.0 0.0 0.0))) (("kTextString" "sfsf") ("kLocation" (70318.8 20461.6 0.0)) ("kCapsHeight" 2.5) ("kWidthFactor" 1.0) ("kColorIndex" 256) ("kColor" (0 0 0)) ("kNormal" (0.0 0.0 1.0)) ("kDirection" (1.0 0.0 0.0)) ("kExtents" (5.55423 2.58356)) ("kFont" nil) ("kBigFont" nil) ("kFontName" "Arial") ("kOblique" 0.0) ("kItalic" 0) ("kBold" 0) ("kStackTop" 0) ("kStackBottom" 0) ("kStackThrough" 0) ("kTrackingFactor" 1.0) ("kUnerLined" 0) ("kOverLined" 0) ("kOverPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kUnderPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kStrikePoints" (0.0 0.0 0.0) (0.0 0.0 0.0))) (("kTextString" "fsf") ("kLocation" (70314.2 20457.4 0.0)) ("kCapsHeight" 2.5) ("kWidthFactor" 1.0) ("kColorIndex" 256) ("kColor" (0 0 0)) ("kNormal" (0.0 0.0 1.0)) ("kDirection" (1.0 0.0 0.0)) ("kExtents" (3.80798 2.58356)) ("kFont" nil) ("kBigFont" nil) ("kFontName" "Arial") ("kOblique" 0.0) ("kItalic" 0) ("kBold" 0) ("kStackTop" 0) ("kStackBottom" 0) ("kStackThrough" 0) ("kTrackingFactor" 1.0) ("kUnerLined" 0) ("kOverLined" 0) ("kOverPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kUnderPoints" (0.0 0.0 0.0) (0.0 0.0 0.0)) ("kStrikePoints" (0.0 0.0 0.0) (0.0 0.0 0.0))))

kmliro_2017

感谢分享！！！！！！