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

qq509103902

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

78946299

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

MXS

厉害厉害，留个位置

672505821

学习了，感谢分享

mikewolf2k

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

xyp1964

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

vlisp2012

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

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

Gu_xl

加载[url=http://bbs.mjtd.com/thread-113010-1-1.htmlXLRX_API[/url]:
(xlrx-get (car(entsel))"text")
cad2007以上版本适用

qq509103902

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

1. (DEFUN C:tt(/ N SS   )
   
2.         (setq sstxt (ssget '((0 . "TEXT,MTEXT"))))
   
3.           (SETQ N 0)
   
4.           (WHILE (< N (SSLENGTH sstxt));;
   
5.                
   
6.                 ;;去除MTEXT中字符串的格式
   
7.                
   
8.                 (setq mtext (CDR(ASSOC 1 (ENTGET (SSNAME sstxt N)))))
   
9.                 (setq txt (mtext2text mtext))
   
10.                
    
11.                 ;;提取出厂编号,如"AQ-1-XX"
    
12.                 (setq  x1 (vl-string-search "编号" txt) )
    
13.                 (setq  x2 (vl-string-search "面积" txt) )
    
14.                 (if (>  x1  10)
    
15.                        
    
16.                         (progn       
    
17.                                
    
18.                                 (setq txtend (substr txt (+ x1 6) (- x2 (+ x1 13))))
    
19.                                 (print txtend)
    
20. 
    
21.                         )
    
22.                 )
    
23.                
    
24.                 (SETQ N (1+ N))
    
25.            )
    
26. )
    
27. 
    
28. ;;; ==========================================
    
29. ;;; 去除MTEXT中字符串的格式,转化为TEXT
    
30. ;;; ==========================================
    
31. (defun mtext2text(MTextString / regex s)
    
32.   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
    
33.   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
    
34.   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
    
35.   (setq s MTextString)
    
36.    ;替换\\字符
    
37.   (vlax-put-property regex "Pattern" "\\\\\\\\")
    
38.   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
    
39.    ;替换\{字符
    
40.   (vlax-put-property regex "Pattern" "\\\\{")
    
41.   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
    
42.    ;替换\}字符
    
43.   (vlax-put-property regex "Pattern" "\\\\}")
    
44.   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
    
45.    ;删除段落缩进格式
    
46.   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
    
47.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
48.    ;删除制表符格式
    
49.   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
    
50.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
51.    ;删除堆迭格式
    
52.   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
    
53.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
54.    ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
    
55.   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
    
56.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
57.    ;删除下划线、删除线格式
    
58.   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
    
59.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
60.    ;删除不间断空格格式
    
61.   (vlax-put-property regex "Pattern" "\\\\~")
    
62.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
63.    ;删除换行符格式
    
64.   (vlax-put-property regex "Pattern" "\\\\P")
    
65.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
66.    ;删除换行符格式(针对Shift+Enter格式)
    
67.   (vlax-put-property regex "Pattern" "\n")
    
68.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
69.    ;删除{}
    
70.   (vlax-put-property regex "Pattern" "({|})")
    
71.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
72.    
    
73.    ;替换回\\,\{,\}字符
    
74.   (vlax-put-property regex "Pattern" "\\x01")
    
75.   (setq s(vlax-invoke-method  regex "Replace" s "\\"))
    
76.   (vlax-put-property regex "Pattern" "\\x02")
    
77.   (setq s(vlax-invoke-method  regex "Replace" s "{"))
    
78.   (vlax-put-property regex "Pattern" "\\x03")
    
79.   (setq s(vlax-invoke-method  regex "Replace" s "}"))
    
80.    
    
81.   (vlax-release-object regex)
    
82.   s
    
83. )

(DEFUN C:tt(/ N SS   )<br />         (setq sstxt (ssget '((0 . "TEXT,MTEXT")))) <br />           (SETQ N 0)<br />           (WHILE (< N (SSLENGTH sstxt));;<br />                 <br />                 ;;去除MTEXT中字符串的格式<br />                 <br />                 (setq mtext (CDR(ASSOC 1 (ENTGET (SSNAME sstxt N)))))<br />                 (setq txt (mtext2text mtext))<br />                 <br />                 ;;提取出厂编号,如"AQ-1-XX"<br />                 (setq  x1 (vl-string-search "编号" txt) )<br />                 (setq  x2 (vl-string-search "面积" txt) )<br />                 (if (>  x1  10) <br />                         <br />                         (progn        <br />                                 <br />                                 (setq txtend (substr txt (+ x1 6) (- x2 (+ x1 13))))<br />                                 (print txtend)<br /> <br />                         )<br />                 )<br />                 <br />                 (SETQ N (1+ N))<br />            )<br /> )<br /> <br /> ;;; ==========================================<br /> ;;; 去除MTEXT中字符串的格式,转化为TEXT<br /> ;;; ==========================================<br /> (defun mtext2text(MTextString / regex s)<br />   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件<br />   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写<br />   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配<br />   (setq s MTextString)<br />    ;替换\\字符<br />   (vlax-put-property regex "Pattern" "\\\\\\\\")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))<br />    ;替换\{字符<br />   (vlax-put-property regex "Pattern" "\\\\{")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))<br />    ;替换\}字符<br />   (vlax-put-property regex "Pattern" "\\\\}")<br />   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))<br />    ;删除段落缩进格式<br />   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除制表符格式<br />   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除堆迭格式<br />   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式<br />   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除下划线、删除线格式<br />   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除不间断空格格式<br />   (vlax-put-property regex "Pattern" "\\\\~")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除换行符格式<br />   (vlax-put-property regex "Pattern" "\\\\P")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除换行符格式(针对Shift+Enter格式)<br />   (vlax-put-property regex "Pattern" "\n")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    ;删除{}<br />   (vlax-put-property regex "Pattern" "({|})")<br />   (setq s(vlax-invoke-method  regex "Replace" s ""))<br />    <br />    ;替换回\\,\{,\}字符<br />   (vlax-put-property regex "Pattern" "\\x01")<br />   (setq s(vlax-invoke-method  regex "Replace" s "\\"))<br />   (vlax-put-property regex "Pattern" "\\x02")<br />   (setq s(vlax-invoke-method  regex "Replace" s "{"))<br />   (vlax-put-property regex "Pattern" "\\x03")<br />   (setq s(vlax-invoke-method  regex "Replace" s "}"))<br />    <br />   (vlax-release-object regex)<br />   s<br /> )

小诚

不错不错，收藏了来自: Android客户端

wzg356

好同志，继续加油

yoyoho

感谢分享程序,学习了!