提取TEXT/MTEXT内的纯文本，过滤文字样式格式

蜀国的大熊猫

1. (if (null vlax-dump-object) (vl-load-com));;将 Visual LISP 扩展功能加载到 AutoLISP
   
2. 
   
3. ;提取多行文字,去除无用格式符号--(一级)----
   
4. ;由尘缘一生提供 QQ：15290049
   
5. 
   
6. (defun gets-mt (nam / s ob)
   
7. 
   
8.   (setq s (vlax-get (vlax-ename->vla-object nam) 'TextString))
   
9. 
   
10.   (vlax-put-property (setq ob (vlax-create-object "Vbscript.RegExp")) "IgnoreCase" 0)
    
11. 
    
12.   (vlax-put-property ob "Global" 1)
    
13. 
    
14.   (setq s
    
15. 
    
16.     (mapcar
    
17. 
    
18.       '(lambda (x y) (vlax-put-property ob "Pattern" x) (setq s (vlax-invoke-method ob "Replace" s y)))
    
19. 
    
20.       '("\\\\\\\\" "\\\\{" "\\\\}" "\\\\p(.[^;]*);" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);"
    
21. 
    
22.          "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);" "(\\\\L|\\\\O|\\\\l|\\\\o)" "\\\\~"
    
23. 
    
24.          "\\\\P" "\n" "({|})" "\\x01" "\\x02" "\\x03")
    
25. 
    
26.       (list (chr 1) (chr 2) (chr 3) "" "" "" "" "" (chr 0) "" "" "\\" "{" "}")
    
27. 
    
28.     )
    
29. 
    
30.   )
    
31. 
    
32.   (if ob (vlax-release-object ob))
    
33. 
    
34.   (last s)
    
35. 
    
36. )
    
37. 
    
38. 
    
39. 
    
40. ;样例
    
41. 
    
42. (defun  c:tt (/ str)
    
43. 
    
44.   (setq mtext_name (car(entsel "\n 请选择MTEXT文字:?")))
    
45. 
    
46.   (setq str (gets-mt mtext_name))
    
47. 
    
48.   str
    
49. 
    
50. )
    
51. 
    

(if (null vlax-dump-object) (vl-load-com));;将 Visual LISP 扩展功能加载到 AutoLISP<br /> <br /> ;提取多行文字,去除无用格式符号--(一级)----<br /> <font color="#800"><font face="Consolas, monospace"><font style="font-size:19px">;由尘缘一生提供 QQ：15290049</font></font></font><br /> <br /> (defun gets-mt (nam / s ob)<br /> <br />   (setq s (vlax-get (vlax-ename->vla-object nam) 'TextString))<br /> <br />   (vlax-put-property (setq ob (vlax-create-object "Vbscript.RegExp")) "IgnoreCase" 0)<br /> <br />   (vlax-put-property ob "Global" 1)<br /> <br />   (setq s<br /> <br />     (mapcar<br /> <br />       '(lambda (x y) (vlax-put-property ob "Pattern" x) (setq s (vlax-invoke-method ob "Replace" s y)))<br /> <br />       '("\\\\\\\\" "\\\\{" "\\\\}" "\\\\p(.[^;]*);" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);"<br /> <br />          "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);" "(\\\\L|\\\\O|\\\\l|\\\\o)" "\\\\~"<br /> <br />          "\\\\P" "\n" "({|})" "\\x01" "\\x02" "\\x03")<br /> <br />       (list (chr 1) (chr 2) (chr 3) "" "" "" "" "" (chr 0) "" "" "\\" "{" "}")<br /> <br />     )<br /> <br />   )<br /> <br />   (if ob (vlax-release-object ob))<br /> <br />   (last s)<br /> <br /> )<br /> <br /> <br /> <br /> ;样例<br /> <br /> (defun  c:tt (/ str)<br /> <br />   (setq mtext_name (car(entsel "\n 请选择MTEXT文字:?")))<br /> <br />   (setq str (gets-mt mtext_name))<br /> <br />   str<br /> <br /> )<br /> <br />

BestYou

感谢分享代码

不一样地设计

感谢楼主分享

xyp1964

MTEXT直接炸开获取更简单明了……

zilong136

天正文字不正持