★“一刀屠文”－在ｌｉｓｐ中应用正则表达式进行字符处理

雨箭风刀

　在lisp中应用正则表达式[/SIZE] [/COLOR]

[序][/COLOR]


   长久以来，文本的编辑一直是lisp编程的重点、难点之一，有不少活跃在xdcad和明经通道论坛的高手为此写了不少有代表性的文字处理工具，比较知名的如：   。而我自己也写过不少这方面的程序，多数没有发表，少数零星地发布在以上两个论坛。但由于lisp对文本编辑(*注)的支持函数不够丰富，而实际工作中遇到的情况又多种多样，使得诸多lisp程序对文本编辑的深度和灵活性上还有很多不足之处，不免遗憾。
   为此，我一直以来寻求更好的方法，最终只有一个答案：正则表达式。正则表达式对文本编辑很强，有多强？看看vb或vbs参考就知道，也可上网一搜。但是，也许本人孤陋寡闻(或是有的高手潜水潜得很深)，在网上一直没有见过在lisp中比较充分地应用正则表达式的程序。其实，我很早就想将正则表达式移植到lisp里面来，近几日一鼓作气，终有小成。谨奉献两个函数：(xxexp)(xxexpr)，这两个函数提供了正则表达式的接口，使在lisp中得以应用其强大的功能成为可能。                                 
                                                        ―――――梁雄啸.2007.7
                                                      
[*注:“文本”在本文均指对文本字符串内容，非指文本实体(0 . “*TEXT”)]

函数下载
函数帮助文件

[函数介绍][/COLOR]

[php]
函数：(xxexp pat str key)
功能 对字符串进行正则表达式匹配测试.
参数: pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \ 号要用　\\ 替代.
     str = 字符串
     key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.”m”多行模式（Multiline），以上几个关键字可以组合使用，或用 ””.
返回: 返回匹配的字符列表，或无一匹配返回nil
[/php]
[php]
函数：(xxexpr pat str nstr key)
功能 对字符串进行正则表达式替换.
参数: pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \ 号要用　\\ 替代.
     str = 被替换字符串
     nstr = 替换字符串
     key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.”m”多行模式（Multiline），以上几个关键字可以组合使用，或用 ””.
返回 :返回替换后的字符串.
[/php]

[正则表达式模式][/COLOR]


　正则表达式核心就是其模式(expression)，此部分资料可从网上或vb，vbs参考中得到。以下是vbs参考中关于模式的描述列表（本文略）。在xxexp,xxexpr函数应用中,注意”\”符要按”\\”来写。

[实战][/COLOR]


   也许只有通过一些实例，大家才真正知道正则表达式的强大。有的功能是仅仅用lisp提供的函数很难或无法做到的，而在这里，可一一化解。
[php]   
1. 汉字和非汉字提取

   先来点简单的，好让大家进入状态，虽然简单，但是在论坛上是经常被问到的问题：
   
·;;提取汉字及空格。
    ;每字分断,汉字按1个字.
     (xxexp "[^!-~]" "a 测π啊d4少1数★M=3;is=正,2确" "")
    ;返回: (" " "测" "π" "啊" "少" "数" "★" "正" "确")
    ;连字不分断.
    (xxexp "[^!-~]+" "a 测π啊d4少1数★M=3;is=正,2确" "")
     ;返回:(" 测π啊" "少" "数★" "正" "确")
   
·;;提取汉字
    (xxexp "[^ -~]" "a 测π啊d4少1数★M=3;is=正,2确" "")
    (xxexp "[^\\000-\\377]" "a 测π啊d4少1数★M=3;is=正,2确" "")
    ;返回: ("测" "π" "啊" "少" "数" "★" "正" "确")
    (xxexp "[\\u0C04-\\uFFFF]" "a 测π啊d4少1数★M=3;is=正,2确" "")
    ;;返回: ("测" "啊" "少" "数" "★" "正" "确") ;;（注: 查到16进制汉字从\\u0C04开始,这个方法应该是最准确的.）
    (xxexp "[^ -~]+" "a 测π啊d4少1数★M=3;is=正,2确" "")
    (xxexp "[^\\000-\\377]+" "a 测π啊d4少1数★M=3;is=正,2确" "")
     ;返回:("测π啊" "少" "数★" "正" "确")

·;;提取非汉字
(xxexp "[ -~]" "a 测π啊d4少1数★M=3;is=正,2确" "")
;返回:("a" " " "d" "4" "1" "M" "=" "3" ";" "i" "s" "=" "," "2")
(xxexp "[\\000-\\377]+" "a 测π啊d4少1数★M=3;is=正,2确" "")
;返回: ("a " "d4" "1" "M=3;is=" ",2")

·;;提取字母及数字
(xxexp "\\w" "a 测π啊d4少1数★M=3;is=正,2确" "")
;返回:("a" "d" "4" "1" "M" "3" "i" "s" "2")

·;;提取非字母及非数字
(xxexp "[^\\w]" "a 测π啊d4少1数★M=3;is=正,2确" "")
  ;返回:(" " "测" "π" "啊" "少" "数" "★" "=" ";" "=" "正" "," "确")
(xxexp "[^\\w]+" "a 测π啊d4少1数★M=3;is=正,2确" "")
;返回:(" 测π啊" "少" "数★" "=" ";" "=正," "确")
·;; 提取连续两个相同的字符
    (SETQ S (xxexp "(.)\\1" "aa看看 测试\"M==33\";is=,,2" ""))
    ;返回: ("aa" "看看" "==" "33" ",,")
[/php]
2. 字符串处理

　看了上面的实例，大家也许有点兴趣了，好，接着来。
[php]　
·;; 提取由分界符界定的字符，呵呵，这个是论坛上被编写的比较多的程序之一.
(xxexp "[^ ;,]+" "a 测试M=3;is=,2" "") ;;返回: ("a" "测试M=3" "is=" "2")
是不是很容易? 但这只不过是牛刀小试，现在才刚刚开始。

·拆分字符串，1个汉字算1个.
(xxexp "."  "少1 ,至.2e-5a‖〉∑∵∩∪チネヒжъμㄜ啊d4少1数" "")
;返回: ("少" "1" " " "," "至" "." "2" "e" "-" "5" "a" "‖" "〉" "∑" "∵" "∩" "∪" "チ" "ネ" "ヒ" "ж" "ъ" "μ" "ㄜ" "啊" "d" "4" "少" "1" "数")

·按每两个字符进行分断。1个中文按1个计算。
(xxexp ".{2}" "aa 测试M==33;is=,,2" "")
;;返回: ("aa" " 测" "试M" "==" "33" ";i" "s=" ",,")

·;;在两个连续字符处分断.（包含指定的分界符，本例指"｜"）
(setq s1 "aa 测看看试M==33;is=,,2")
(xxexp "[^｜]+" (xxexpr "(.)\\1" s1 "｜" "") "")
;返回: (" 测" "试M" ";is=" "2")

·倒排文字（按字倒排，支持中文）
(setq str "The quick brown 啊 fox jumped 至 over ∑ the lazy dog.")
(apply 'strcat (reverse(xxexp "." str "")))
;返回: ".god yzal eht ∑ revo 至 depmuj xof 啊 nworb kciuq ehT"
  (apply 'strcat (reverse(xxexp "." "i开头，跟至少1个s" "")))
  ;返回:  "s个1少至跟，头开i"

·简单替换，（但是用lisp写也不见得简单:) ）
   (setq str "IS11 is01 ISa1 iss11 id1 isss1 is1 IS1 ISa")
2.1 替换 is 为*，不分大小写
(xxexpr "is" str "*" "") ;-> "*11 *01 *a1 *s11 id1 *ss1 *1 *1 *a"
2.2 替换 i开头,跟s(至少1个)的字符 为*
(xxexpr "is+" str "*" "") ;-> "*11 *01 *a1 *11 id1 *1 *1 *1 *a"
2.3 替换 非数字和非空格 为*
(xxexpr "[^0-9 ]" str "*" "") ;->"**11 **01 ***1 ***11 **1 ****1 **1 **1 ***"
2.4 替换 i开头，至少跟2个s的字符为*
(xxexpr "Is{2,}" str "*" "") ;-> "IS11 is01 ISa1 *11 id1 *1 is1 IS1 ISa"
2.5 替换 i开头，跟1个非换行符的字符为*
(xxexpr "I." str "*" "") ;-> "*11 *01 *a1 *s11 *1 *ss1 *1 *1 *a"
2.6 替换 i开头，跟至少1个s,+至少1个数字的字符　为*
(xxexpr "is{1,}\\d+" str "*" "")　;－> "* * ISa1 * id1 * * * ISa"
[/php]
下面的加点难度:
[php]
·.倒排文字(按空格划分)
(setq str "The quick brown 啊 fox jumped 至于 over ∑ the lazy dog")
(setq lst1 (xxexp "[^ |.]+" str ""))
  ;;返回: ("The" "quick" "brown" "啊" "fox" "jumped" "至于" "over" "∑" "the" "lazy" "dog.")
(setq lst2 (xxexp " +" str ""))
;;返回: (" " " " " " " " " " " " " " " " " " " " " " ".")
(apply 'strcat (mapcar 'strcat (reverse lst1)(reverse lst2)))
;;返回: "dog lazy the ∑ over 至于 jumped fox 啊 brown quick "

·.字符倒置
　;; 将符合匹配(词1+空格+词2)中词1和词2对调
(xxexpr "(\\S+)(\\s+)(\\S+)" "brown  啊 fox a" "$3$2$1" "") ;;返回:"啊  brown a fox"
;;将 = 号左右两边的字符对调.
(xxexpr "(.)([-|=])(.)" "a-b=1 : c=d : a" "$3$2$1" "") ;;返回: "b-a=1 : d=c : a"
[/php]
3. 有条件的文本替换:

再加点难度。
[php]
·; "*(*)" 替换为 "*

"，论坛上只见过lzh写过这样一个程序，是用vba写的。
(xxexpr "(\\()([^\\(\\)]*)(\\))" "a(顶-啊)5()" "[$2]" "")
;返回: "a[顶-啊]5[]"

·; A*B*替换为B*C*
(xxexpr "(A{1})([^ABab]*)(B{1})" "A48.B小4Axa8b5" "B$2C" "") ;替换所有匹配
;返回: "B48.C小4AxB8C5"
(xxexpr "(A{1})([^ABab]*)(B{1})" "A48.B小4Axa8b5" "B$2C" "g");替换第一个匹配的字符串
;返回:"B48.C小4Axa8b5"

·;将符合 "*写程序*Yes*" 的字符串替换为 "*测*试*" .这个是不等式替换，用vlisp写起来容易么？
(xxexpr "(.*)写程序(.*)Yes(.*)" "33写程序74=YesYb" "$1测$2试$3" "")
;返回:"33测74=试Yb"
　再来几个对比测试，什么功能？有点考脑力啊：）
(xxexpr "(.*)写程序(.*)Yes(.*)" "33写程序74=YesYb" "$1测$2$3" "")
  ;->"33测74=Yb"　　           ；将”写程序”替换为”测”,去掉”Yes”
(xxexpr "(.*)写程序(.*)Yes(.*)" "33写程序74=YesYb" "$1测$3" "")
　;->"33测Yb"                 ; 去掉”写程序””Yes”及其之间的字符。
(xxexpr "(.*)写程序(.*)Yes(.*)" "33写程序74=YesYb" "$2" "")
;->"74="　                       ; 仅保留”写程序*Yes”之间的*部分.
(xxexpr "(.*)(写程序)(.*)(Yes)(.*)" "33写程序74=YesYb" "$1$4$2$3$5" "")
;->"33Yes写程序74=Yb"           ;将各部分随意倒置.
(xxexpr "(.*)写(程序)(.*)(Yes)(.*)" "33写程序74=YesYb" "$1看$2$3$5,$4!" "")
;->"33看程序74=Yb,Yes!"   ; 将"*写程序*Yes*"中的”写”改为看,”Yes”放到最后并加标点

· 替换字符串.将=号后的10~99的数字字符改为*
(xxexpr "(.=)(\\d{2})([^\\d]+)" "M=56变量" "$1*$3" "") ;;返回:"M=*变量"
(xxexpr "(.=)(\\d{2})([^\\d]+)" "M=6变量" "$1*$3" "") ;;返回:"M=6变量"
(xxexpr "(.=)(\\d{2})([^\\d]+)" "M=556变量" "$1*$3" "") ;;返回:"M=556变量"

·;; 更改字符中包含 M=数字 的字符，将M改为X
(xxexpr "(M)(=)(\\d+)" "2至M=56变量" "X$2$3" "") ;;返回:"2至X=56变量"

·;; 将字符中a*d分别改为M*N
(xxexpr "(a)(.+)(d)" "测试a=c,d=e,a=3,d=1" "M$2N" "")
;;返回: "测试M=c,d=e,a=3,N=1" （全字按顺序匹配）
(xxexpr "(a)([^a|d]+)(d)" "测试a=c,d=e,a=3,d=1" "M$2N" "")
;;返回:"测试M=c,N=e,M=3,N=1"  （所有按顺序匹配）.

·将字符 "我们*测试" 中的* 改为"不"字
(xxexpr "(.*今天)([^测试]*)(测试?.*)" "今天我们一起测试这个函数，你来测试" "$1不$3" "")
; ;返回:"今天不测试这个函数，你来测试";;（仅匹配第一次遇到的"测试"二字）
  (xxexpr "(.*今天)(.*)(测试.*)" "今天我们一起测试这个函数，你来测试" "$1不$3" "")
;;返回:"今天不测试" （;; 匹配最外层的"测试"二字）
[/php]

是不是越来越晕了？还有呢,下面是两个测试，是有一定实践意义的更改文本内数字的程序。
[php]
·;; 更改字符中包含 M=数字 的字符，将数字加1.5。可能还有更好更有效的写法。
(defun c:test1()
(setq str "2至M=56.5变M=3量M=.22"
       pat "(M)(=)(\\d{0,}\\.{0,1}\\d{1,})")
  (setq lst (xxexp pat str ""))
  ;; 此步返回: ("M=56.5" "M=3" "M=.22")
  (setq lst2(mapcar '(lambda(x)(strcat "M=" (rtos(+ 1.5(distof(vl-string-subst "" "M=" x)))2 2)))lst))
  ;此步返回:("M=58.00" "M=4.50" "M=1.72")
  (mapcar '(lambda(x y)(setq str (xxexpr x str y ""))) lst lst2)
  str)
;;最后返回: "2至M=58.00变M=4.50量M=1.72"

· ;; 将a=或d=开头的数字加一个数(1.75).。另外一种写法。
(defun c:test2()
    (setq str "测试a=2,d=3结果f=2,aa-3"
       add 1.75
       jd 2) ;精度
    (setq str2 (xxexpr "([a|d])(=)(\\d+)" str (strcat"$1$2(+ " (rtos add 2 jd) " $3)") ""))
    ;;返回: "测试a=(+ 1.75 2),d=(+ 1.75 3)结果f=2,aa-3"
    (setq as (mapcar '(lambda(x)(eval(read x))) (xxexp "(\\([^()]*\\))" str2  "")))
    ;;返回:("(+ 1.75 2)" "(+ 1.75 3)");返回:(3.75 4.75)
    (mapcar '(lambda(x)(setq str2 (xxexpr "([a|d])(=)(\\([^()]*\\))" str2 (strcat "$1$2" (rtos x 2 jd)) "g"))) as)
    str2
) ;;最后返回: "测试a=3.75,d=4.75结果f=2,aa-3"
[/php]

4. 提取数字文本:

   之所以把这个专门做一小节，是因为现实意义较大，而我以前也用vlisp写过这样的程序，但写起来难免有些考虑不到的情况，总是不爽，现在，终于可以松一口气。
   先说说字符中的数字可能出现的情况。其实很简单，就是distof认得的就应该看做数字。如：
“+1“ “+1.0““+.3““1.3““1.3e1“ “1.3e2““1.3e-2“ 等.
虽然乍一看简单，但是如果遇到“..2.3 +-2.5.6e-3.6 -1d.+3e.1“等不规范的字符串，要正确提取数字用lisp写起来可就困难了。
现在看看正则表达式的功能如何，下面是我摸索到的，pat也许有更科学的写法。
[php]
·提取字符串内数字1:
(setq str "a-.3A0.0+9.5d-1.3 1.2e-58d4d-15.1d5.6asf-1.2"
       pat "[+|-]?\\d*\\.?\\d+(e[+|-]*\\d+)*")
(xxexp  pat str "")
;;返回:("-.3" "0.0" "+9.5" "-1.3" "1.2e-58" "4" "-15.1" "5.6" "-1.2")
;;下面再验证是否是数字.
   (mapcar 'distof (xxexp  pat str ""))
   ;;返回:(-0.3 0.0 9.5 -1.3 1.2e-058 4.0 -15.1 5.6 -1.2)

·提取字符串内数字2：
(setq str "-1e4-31++3485..3.1a.38 3..14f-.86e-1d3.a4f8.48"
       pat "[+|-]?\\d*\\.?\\d+(e[+|-]*\\d+)*")
(xxexp  pat str "")
;;返回:　("-1e4" "-31" "+3485" ".3" ".1" ".38" "3" ".14" "-.86e-1" "3" "4" "8.48")
;;下面再验证是否是数字.
   (mapcar 'distof (xxexp  pat str ""))
   ;;返回:(-10000.0 -31.0 3485.0 0.3 0.1 0.38 3.0 0.14 -0.086 3.0 4.0 8.48)
[/php]
5. 函数各参数对比   

  结束前，对函数的各参数的用法做一些实例，以便通过对比加深理解。
[php]
·xxexp参数及partten对比测试
(setq str "IS11 is01 ISa1 iss11 id1 isss1 is1 IS1 ISa")
1.1;查找 str 中符合　is开头跟至少１个数字的字符.　i 大小写敏感；g　全局(仅找第一个符合条件的字符)
(xxexp "is\\d+" str "iG") ;-> ("is0") ;　小写，第一个
(xxexp "is\\d+" str "i") ;-> ("is01" "is1")　;小写，全局
(xxexp "is\\d+" str "g") ;->("IS11");大小写，第一个
(xxexp "is\\d+" str "") ;-> ("IS11" "is01" "is1" "IS1");大小写，所有.
1.2 查找IS开头,跟非换行单字符，跟0-9数字
(xxexp "IS.[0-9]" str "") ;-> ("IS11" "is01" "ISa1" "iss1")
1.3 查找IS开头,跟非A或a，跟0-9数字
(xxexp "IS[^Aa][0-9]" str "") ;->("IS11" "is01" "iss1")
1.4 查找IS开头,至少两个S的字符
(xxexp "IS{2,}" str "") ;-> ("iss" "isss")
1.5 查找IS开头,跟两个数字
(xxexp "IS[0-9][0-9]" str "") ;-> ("IS11" "is01")
1.6 查找IS开头,跟两个数字,大小写敏感.
(xxexp "IS[0-9][0-9]" str "i") ;-> ("IS11")
1.7 查找IS开头,跟1个数字.
(xxexp "IS[0-9]" str "") ;-> ("IS1" "is0" "is1" "IS1")
1.8 查找IS开头,跟1个数字,跟空格.
(xxexp "IS[0-9] " str "") ;-> ("is1 " "IS1 ")
[/php][php]
·xxexp和xxexpr的配合使用
   Xxexp 可提取符合条件的字符(列表)，得到的表可提供给别的程序进行进一步处理。
   Xxexpr 替换的结果(个数)，可以用xxexp预知。
     (xxexp "\\band\\b" "weekend,endfor,end" "") ;返回: nil ;没有一个匹配
　(xxexpr "\\band\\b" "weekend,endfor,end" "start" "")
　　;返回:"weekend,endfor,end" ;不改变字符串
(xxexp "\\bend\\b" "weekend,endfor,end" "")  
;返回: ("end") ;; 仅仅有一个匹配. \\b:指单词边界.
(xxexpr "\\bend\\b" "weekend,endfor,end" "start" "")
;返回: "weekend,endfor,start" ;仅替换一个.
(xxexp "end" "weekend,endfor,end" "")
  ;返回: ("end" "end" "end") ;;有三个匹配
(xxexpr "end" "weekend,endfor,end" "start" "")
  ;返回: "weekstart,startfor,start" ;替换3个.
  [/php]

[结语：“一刀屠文”][/COLOR]


   通过pat，和key的不同设定，可以看到正则表达式的功能不是一般的强，对应一种要求，pat可能有不只一种写法，只要pat写的好，在字符处理上，你能做的很多很多，而且也轻而易举，免去写n个程序的痛苦。呵呵，我以前写的几十个字符串处理函数很多都要下岗贱卖了。
   差点忘了给这两个函数起个名号了，鉴于文字处理方面叫的好听的名号都被用的差不多了，大师之类的又不敢叫，一时间也想不到更好的，暂时叫“一刀屠文”吧，“屠”，表示对文字的深入解析，刀随心动，所向披靡，物我两忘。（%^$哎哟!谁砸的砖头!$%#）
   今天就到这里吧，更多更强的功能等待你去发现。
   
   
                                                           梁雄啸
      2007.7.28夜

eachy

MSDN上的资料
http://msdn.microsoft.com/librar ... ularExpressions.asp
[iframe h=600 w=100%]http://msdn.microsoft.com/library/shared/deeptree/asp/rightframe.asp?dtcfg=/library/chs/deeptreeconfig.xml&url=/library/CHS/jscript7/html/jsjsgrpregexpsyntax.asp?frame=true&hidetoc=false[/iframe]

梦断江南

正则表达式模式
http://msdn.microsoft.com/librar ... grpregexpsyntax.asp

dandee

牛。但无法下载

Free-Lancer

RegExp 用法很简单，就是那些匹配规则头大~~~
xxexp 用的是 Execute 方法，xxexpr 用的是Replace方法。
下例是 Execute 的VBA写法

2. 
   
3. Sub RegExpTest()
   
4.   Dim regEx, Match, Matches, patten      ' Create variable.
   
5.   patrn = "is."
   
6.   strng = "IS1 is2 IS3 is4"
   
7.   Set regEx = CreateObject("vbscript.RegExp")         ' Create a regular expression.
   
8.   regEx.Pattern = patrn         ' Set pattern.
   
9.   regEx.IgnoreCase = True         ' Set case insensitivity.
   
10.   regEx.Global = True         ' Set global applicability.
    
11.   Set Matches = regEx.Execute(strng)   ' Execute search.
    
12.   For Each Match In Matches      ' Iterate Matches collection.
    
13.     RetStr = RetStr & "Match found at position "
    
14.     RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
    
15.     RetStr = RetStr & Match.Value & "'." & vbCrLf
    
16.   Next
    
17.   MsgBox RetStr
    
18. End Sub

<br /> Sub RegExpTest()<br />   Dim regEx, Match, Matches, patten      ' Create variable.<br />   patrn = "is."<br />   strng = "IS1 is2 IS3 is4"<br />   Set regEx = CreateObject("vbscript.RegExp")         ' Create a regular expression.<br />   regEx.Pattern = patrn         ' Set pattern.<br />   regEx.IgnoreCase = True         ' Set case insensitivity.<br />   regEx.Global = True         ' Set global applicability.<br />   Set Matches = regEx.Execute(strng)   ' Execute search.<br />   For Each Match In Matches      ' Iterate Matches collection.<br />     RetStr = RetStr & "Match found at position "<br />     RetStr = RetStr & Match.FirstIndex & ". Match Value is '"<br />     RetStr = RetStr & Match.Value & "'." & vbCrLf<br />   Next<br />   MsgBox RetStr<br /> End Sub

[iframe h=600 w=100%]http://rubycn.ce-lab.net/man/built-in-class/class_object_regexp.html[/iframe]

雨箭风刀

为方便大家，现提供函数和函数帮助的下载地址

http://dreamskylxx.ys168.com/   在“ｃａｄ程序共享”目录下

Free-Lancer

简单翻译一下上面的　VBA

2. 
   
3. (defun string-search (pat str / regex)
   
4.   (if (setq regex (vlax-get-or-create-object "vbscript.regexp"))
   
5.     (progn
   
6.       (vlax-put-property regex "IgnoreCase" 0) ;_不忽略大小写
   
7.       (vlax-put-property regex "Global" 1) ;_匹配方式，全文字匹配
   
8.       (vlax-put-property regex "Pattern" pat)
   
9.       (if (setq Matches (vlax-invoke-method regex 'Execute str))
   
10.         (vlax-for Match        Matches
    
11.           (setq Strl (cons (vlax-get-property Match 'Value) strl))
    
12.         )
    
13.       )
    
14.       (vlax-release-object regex)
    
15.     )
    
16.   )
    
17.   (reverse strl)
    
18. )

<br /> (defun string-search (pat str / regex)<br />   (if (setq regex (vlax-get-or-create-object "vbscript.regexp"))<br />     (progn<br />       (vlax-put-property regex "IgnoreCase" 0) ;_不忽略大小写<br />       (vlax-put-property regex "Global" 1) ;_匹配方式，全文字匹配<br />       (vlax-put-property regex "Pattern" pat)<br />       (if (setq Matches (vlax-invoke-method regex 'Execute str))<br />         (vlax-for Match        Matches<br />           (setq Strl (cons (vlax-get-property Match 'Value) strl))<br />         )<br />       )<br />       (vlax-release-object regex)<br />     )<br />   )<br />   (reverse strl)<br /> )

另外一个 Replace

2. 
   
3. (defun string-replace (pat nstr string / regex str)
   
4.   (if (setq regex (vlax-get-or-create-object "vbscript.regexp"))
   
5.     (progn
   
6.       (vlax-put-property regex "IgnoreCase" 0) ;_不忽略大小写
   
7.       (vlax-put-property regex "Global" 1) ;_匹配方式，全文字匹配
   
8.       (vlax-put-property regex "Pattern" pat)
   
9.       (setq str (vlax-invoke-method regex 'Replace string nstr))
   
10.       (vlax-release-object regex)
    
11.     )
    
12.   )
    
13.   str
    
14. )

<br /> (defun string-replace (pat nstr string / regex str)<br />   (if (setq regex (vlax-get-or-create-object "vbscript.regexp"))<br />     (progn<br />       (vlax-put-property regex "IgnoreCase" 0) ;_不忽略大小写<br />       (vlax-put-property regex "Global" 1) ;_匹配方式，全文字匹配<br />       (vlax-put-property regex "Pattern" pat)<br />       (setq str (vlax-invoke-method regex 'Replace string nstr))<br />       (vlax-release-object regex)<br />     )<br />   )<br />   str<br /> )

flowerson

版主，你的下载连接已经下载不了了。请更新。谢谢！