在VLISP中使用正则表达式(一)取多行文字中的有用内容

mccad

我将在以后有空的时间，为大家写一些看起来深一点的知识。
正则表达式，就是使用“Vbscript.RegExp”控件进行文字的查找和替换操作。
普通的文字查找与替换，只能做到替换特定的字符，而不能按照特定的特征进行替换。
例如：一段文字中，需要将“明经通道”几个字都替换为“明经CAD社区”，那直接用替换就可以。
但如果我们有一篇文字，其中需要将“第XX章”全部修改为“第XX节”，而且XX是变化的，需要替换的数量非常多，这时用普通的替换就无能为力了。
这时，我们就得用上正则表达式了。
其实为什么正则表达式在AutoCAD中还没有人提到过使用，那就是因为使用AutoCAD并不是以使用文字为主，所以总少人去研究。但正则表达式在网络编程中使用非常广泛，正如大家看到本站可以大家输入的代码进行语法着色，使用的就是“正则表达式”的功能。呵呵，够强大吧。
在AutoCAD中，也经常会出现象一些明细表、技术要求等之类的文字内容，也会经常碰到过模糊替换的问题。所以多学一些知识是有好处的。
好了，先给大家获取多行文字中的有用字符的LISP代码吧，其实这个代码在几年前已经用VBA解决。而且用LISP的普通代码应该也能解决这样的问题，但如果用正则表达式，则会显得清晰明了。
下一节将会讲一些有关正则表达式的使用方法。

2. (vl-load-com)
   
3. (defun c:m2txt(/ s )
   
4.   (setq s "{\\C3;\\{明经通{\\fSimSun|b0|i0|c134|p2;道\\}}\\Lhttp://www.mjtd.com{\\C3;明经通道\\Lhttp{\\C1;://{\\C3;www}.mjtd.com}\\l是一个好网站啊，呵呵}\\l是{\\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}")
   
5.   (setq mtext(vlax-ename->vla-object(car(entsel "\n选择多行文字："))))
   
6.   (if (=(vla-get-objectname mtext) "AcDbMText")
   
7.     (progn
   
8.       (vla-put-textstring mtext s)
   
9.       (setq s (vla-get-textstring mtext))
   
10.       
    
11.       (setq s (mtext2text s))
    
12.       (princ "\n")
    
13.       (princ s)
    
14.       )
    
15.     (princ "\n出错")
    
16.     )
    
17.   (princ)
    
18.   )
    
19. (defun mtext2text(MTextString / regex s)
    
20.   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
    
21.   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
    
22.   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
    
23.   (setq s MTextString)
    
24.      ;替换\\字符
    
25.   (vlax-put-property regex "Pattern" "\\\\\\\")
    
26.   (setq s(vlax-invoke-method  regex "Replace" s (chr 1)))
    
27.      ;替换\{字符
    
28.   (vlax-put-property regex "Pattern" "\\\\{")
    
29.   (setq s(vlax-invoke-method  regex "Replace" s (chr 2)))
    
30.      ;替换\}字符
    
31.   (vlax-put-property regex "Pattern" "\\\\}")
    
32.   (setq s(vlax-invoke-method  regex "Replace" s (chr 3)))
    
33.      ;删除段落缩进格式
    
34.   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
    
35.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
36.      ;删除制表符格式
    
37.   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
    
38.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
39.      ;删除堆迭格式
    
40.   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
    
41.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
42.      ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
    
43.   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
    
44.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
45.      ;删除下划线、删除线格式
    
46.   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
    
47.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
48.      ;删除不间断空格格式
    
49.   (vlax-put-property regex "Pattern" "\\\\~")
    
50.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
51.      ;删除换行符格式
    
52.   (vlax-put-property regex "Pattern" "\\\\P")
    
53.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
54.      ;删除换行符格式(针对Shift+Enter格式)
    
55.   (vlax-put-property regex "Pattern" "\n")
    
56.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
57.      ;删除{}
    
58.   (vlax-put-property regex "Pattern" "({|})")
    
59.   (setq s(vlax-invoke-method  regex "Replace" s ""))
    
60.      
    
61.      ;替换回\\,\{,\}字符
    
62.   (vlax-put-property regex "Pattern" "\\x01")
    
63.   (setq s(vlax-invoke-method  regex "Replace" s "\"))
    
64.   (vlax-put-property regex "Pattern" "\\x02")
    
65.   (setq s(vlax-invoke-method  regex "Replace" s "{"))
    
66.   (vlax-put-property regex "Pattern" "\\x03")
    
67.   (setq s(vlax-invoke-method  regex "Replace" s "}"))
    
68.      
    
69.   (vlax-release-object regex)
    
70.   s
    
71. )
    

(vl-load-com)<br /> (defun c:m2txt(/ s )<br />   (setq s "{\\C3;\\{明经通{\\fSimSun|b0|i0|c134|p2;道\\}}\\Lhttp://www.mjtd.com{\\C3;明经通道\\Lhttp{\\C1;://{\\C3;www}.mjtd.com}\\l是一个好网站啊，呵呵}\\l是{\\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}")<br />   (setq mtext(vlax-ename->vla-object(car(entsel "\n选择多行文字："))))<br />   (if (=(vla-get-objectname mtext) "AcDbMText")<br />     (progn<br />       (vla-put-textstring mtext s)<br />       (setq s (vla-get-textstring mtext))<br />       <br />       (setq s (mtext2text s))<br />       (princ "\n")<br />       (princ s)<br />       )<br />     (princ "\n出错")<br />     )<br />   (princ)<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 /> )<br />

从程序可以看到，多行文字原来的内容是：

其实际文字内容是：
{\\C3;\\{明经通{\\fSimSun|b0|i0|c134|p2;道\\}}\\Lhttp://www.mjtd.com{\\C3;明经通道\\Lhttp{\\C1;://{\\C3;www}.mjtd.com}\\l是一个好网站啊，呵呵}\\l是{\\Ftxt.shx,gbcbig.shx|c134;一个好网站}啊，呵呵}
经过替换后剩下了：
{明经通道}http://www.mjtd.com明经通道http://www.mjtd.com是一个好网站啊，呵呵是一个好网站啊，呵呵

f4800

感谢大神支持!

zhaomc520

请问版主，你的程式是否可以支持通配符“*”的替换呢？

比如：把“A1BCD" "A1BBD" "A1BDD"同一使用通配符"A2*D"替换成“A2BCE" "A2BBE" "A2BDE"呢？

如果可以，请大侠指导小弟一把如何使用

谢谢

 

mccad

这简直是太简单了，因为正则表达式就是专门为这一类的替换设计的：

(defun c:replacetxt(/ regex s txtstring)
  (setq regex(vlax-create-object "Vbscript.RegExp"));引用正则表达式控件
  (vlax-put-property regex "IgnoreCase" 0); 不忽略大小写
  (vlax-put-property regex "Global" 1);全文匹配，而不是只匹配第一处
  (setq txtstring "A1BCD A1BBD A1BDD ")
  (setq s txtstring)
     ;替换字符
  (vlax-put-property regex "Pattern" "A1(.{2})D")
  (setq s(vlax-invoke-method  regex "Replace" s "A2$1E"))
    
  (vlax-release-object regex)
  (princ (strcat "\n替换前为：" txtstring))
  (princ (strcat "\n替换后为：" s))
  (princ)
)

程序运行结果：
命令: REPLACETXT
替换前为：A1BCD A1BBD A1BDD
替换后为：A2BCE A2BBE A2BDE

phoenixdjq

好，以后多学学

谢谢斑竹

killer9806

看来，以后要加紧学习了

zhaomc520

谢谢版主，会更努力学习的

zhaomc520

版主，你的程式好像不好使呀，执行完了没有反应呀

还有(setq txtstring "A1BCD A1BBD A1BDD")

如果需要替换的文字很多，一一写出来比较麻烦的情况下如何解决呢？能不能不用写入"A1BCD A1BBD A1BDD"字符串呢？

如果可以该如何实现呢？麻烦版主多指教。

mccad

你来个图形文件给试试，你需要做到什么样的操作，选择文字直接替换还是其它。

其实这只教大家一个方法，其它的可以自己加上去，如选择文字，或选择属性块中的文字，可直接打开文件替换等。这些都可以自己写的。关键要掌握方法。

zhaomc520

版主所言甚是，可小弟新手初来乍到，不熟悉，还请多多执教

 

比如我需要把“S3NP33A”改成“S1NP33L”而且类似这样的修改还很多，所以我想请版主帮帮忙，做一个能用通配符"*"的替换lisp的文件，

完成S3*A替换成S1*L而且以*替代的字符串内容不变。如何修改你的程式？请执教

mccad

2. (defun c:reptxt(/ regex s seltext i objtext oldtext)
3.   (princ  "\n明经通道文本模糊替换示例--将S3*A替换为S1*L")
4.   (setq seltext(ssget "X" '((0 . "TEXT"))))
5.   (if  seltext
6.     (progn
7.       (setq i 0)
8.       (setq regex(vlax-create-object "Vbscript.RegExp"));引用正则表达式控件
9.       (vlax-put-property regex "IgnoreCase" 0); 不忽略大小写
10.       (vlax-put-property regex "Global" 1);全文匹配，而不是只匹配第一处
11.       (repeat (sslength seltext)
12.         (setq objtext(vlax-ename->vla-object (ssname seltext i)))
13.         (setq s (vla-get-textstring objtext))
14.         (setq oldtext s)
15.         ;替换字符
16.         (vlax-put-property regex "Pattern" "S3(.{4})A")
17.         (setq s(vlax-invoke-method  regex "Replace" s "S1$1L"))
18.         (vla-put-textstring objtext s)
19.         (if (/= oldtext s)
20.           (progn
21.             (princ (strcat "\n替换前为：" oldtext))
22.             (princ (strcat "\n替换后为：" s))
23.             )
24.           )
25.         (setq i(1+ i))
26.         )
27.       (vlax-release-object regex)
28.       )
29.     )
30.   (princ)
31. )

(defun c:reptxt(/ regex s seltext i objtext oldtext)   (princ  "\n明经通道文本模糊替换示例--将S3*A替换为S1*L")   (setq seltext(ssget "X" '((0 . "TEXT"))))   (if  seltext     (progn       (setq i 0)       (setq regex(vlax-create-object "Vbscript.RegExp"));引用正则表达式控件       (vlax-put-property regex "IgnoreCase" 0); 不忽略大小写       (vlax-put-property regex "Global" 1);全文匹配，而不是只匹配第一处       (repeat (sslength seltext)         (setq objtext(vlax-ename->vla-object (ssname seltext i)))         (setq s (vla-get-textstring objtext))         (setq oldtext s)         ;替换字符         (vlax-put-property regex "Pattern" "S3(.{4})A")         (setq s(vlax-invoke-method  regex "Replace" s "S1$1L"))         (vla-put-textstring objtext s)         (if (/= oldtext s)           (progn             (princ (strcat "\n替换前为：" oldtext))             (princ (strcat "\n替换后为：" s))             )           )         (setq i(1+ i))         )       (vlax-release-object regex)       )     )   (princ) )