qq509103902 发表于 2015-4-3 15:33:56

关于带格式 多行文字中 字符串的提取

具体需求如下:
需要提取出下面多行文字中的 "AA-1-XX" ,其中AA-1-XX的字符串长度与内容都不确定.
求热心人士帮忙解答一下.






78946299 发表于 2023-4-28 23:08:13

厉害，好好看到是自己找了很久的。谢谢。

MXS 发表于 2022-2-26 22:29:50

厉害厉害，留个位置

672505821 发表于 2022-2-21 19:14:00

学习了，感谢分享

mikewolf2k 发表于 2015-4-3 16:58:00

关注下。始终没找到提取Mtext文本内容的方法。

xyp1964 发表于 2015-4-3 20:09:38

"   3：本图出厂编号 AA-1-XX。   4：面积:XXXXXm2。"

vlisp2012 发表于 2015-4-4 10:16:07

对于Mtxet,建议如下，这样你就不用去除前面的控制符了

(setq obj(vlax-ename->vla-object e))
(setq tex (vlax-get obj 'TextString))

Gu_xl 发表于 2015-4-4 11:49:45

加载:
(xlrx-get (car(entsel))"text")
cad2007以上版本适用

qq509103902 发表于 2015-4-4 14:46:55

问题已解决,现放出源码.
在此感谢mccad的源码http://bbs.mjtd.com/thread-57445-1-1.html

(DEFUN C:tt(/ N SS   )
        (setq sstxt (ssget '((0 . "TEXT,MTEXT"))))
          (SETQ N 0)
          (WHILE (< N (SSLENGTH sstxt));;
               
                ;;去除MTEXT中字符串的格式
               
                (setq mtext (CDR(ASSOC 1 (ENTGET (SSNAME sstxt N)))))
                (setq txt (mtext2text mtext))
               
                ;;提取出厂编号,如"AQ-1-XX"
                (setqx1 (vl-string-search "编号" txt) )
                (setqx2 (vl-string-search "面积" txt) )
                (if (>x110)
                       
                        (progn       
                               
                                (setq txtend (substr txt (+ x1 6) (- x2 (+ x1 13))))
                                (print txtend)

                        )
                )
               
                (SETQ N (1+ N))
           )
)

;;; ==========================================
;;; 去除MTEXT中字符串的格式,转化为TEXT
;;; ==========================================
(defun mtext2text(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-methodregex "Replace" s (chr 1)))
   ;替换\{字符
(vlax-put-property regex "Pattern" "\\\\{")
(setq s(vlax-invoke-methodregex "Replace" s (chr 2)))
   ;替换\}字符
(vlax-put-property regex "Pattern" "\\\\}")
(setq s(vlax-invoke-methodregex "Replace" s (chr 3)))
   ;删除段落缩进格式
(vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除制表符格式
(vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除堆迭格式
(vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
(vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除下划线、删除线格式
(vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除不间断空格格式
(vlax-put-property regex "Pattern" "\\\\~")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除换行符格式
(vlax-put-property regex "Pattern" "\\\\P")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除换行符格式(针对Shift+Enter格式)
(vlax-put-property regex "Pattern" "\n")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   ;删除{}
(vlax-put-property regex "Pattern" "({|})")
(setq s(vlax-invoke-methodregex "Replace" s ""))
   
   ;替换回\\,\{,\}字符
(vlax-put-property regex "Pattern" "\\x01")
(setq s(vlax-invoke-methodregex "Replace" s "\\"))
(vlax-put-property regex "Pattern" "\\x02")
(setq s(vlax-invoke-methodregex "Replace" s "{"))
(vlax-put-property regex "Pattern" "\\x03")
(setq s(vlax-invoke-methodregex "Replace" s "}"))
   
(vlax-release-object regex)
s
)

小诚 发表于 2015-4-9 10:32:24

不错不错，收藏了

wzg356 发表于 2015-4-30 17:02:22

好同志，继续加油

yoyoho 发表于 2015-5-2 07:19:38

感谢分享程序,学习了!
页: [1] 2
查看完整版本: 关于带格式 多行文字中 字符串的提取