!强! 在lisp中应用正则表达式

cheng5276

今天刚好在头痛这个咋写这种函数呢，嘿嘿，省事了
拜读大作

xcroy

请问那位朋友能传我一份无痕的正则式函数啊（他的空间进不去了），
xczsb@163.com 或者发消息给我，不胜感谢！！

hvac_wh

我觉得不在乎采用哪种语言进行编程，而是在于你设计的程序是否完整、设计的体系是否有缺陷。本案例中，我觉得还有多种情况没有考虑。如文本中含%%p、%%DC、\U+0201等。在实际使用中经常碰到，按照作者设计的程序，%%p会分解成 "%"、 “%”、“ p”，但实际上它就是一个正负号。另外对于不同的字型文件，还有作者自定义的一些特殊符合，表达特殊的含义。作者就曾经对字库文件把%%242定义为m2（平方米）,这些情况可能就是编程的重点。atolisp发展到现在，功能也已经十分强大了，在AutoCAD后续高版本里，VB.NET可能不会再做主要的开发语言给予支持。但AUTOCAD不会抛弃AUtoLisp。我认为，作者提供的函数运算，就没有考虑这些情况的变化。

qq229918602

有点复杂、、、

pop159

zhongys

好贴，收藏了。

阿霸99

谢谢楼主，这个很强大，但是你的空间要密码才能进去

pimgu

膜拜！膜拜！膜拜！

chlh_jd

geomcal.arx的cal自带四则运算功能，使用举例如下；
批量四则运算

2. (vl-load-com)
   
3. ;;加载geomcal.arx
   
4. (if (not(member "GEOMCAL.ARX" (mapcar (function strcase) (arx))))
   
5.     (arxload (findfile "geomcal.arx"))   
   
6.     )
   
7. (defun c:szys (/ ws ss ssen cal_str ent str x)
   
8.   (prompt
   
9.     "\n计算表达式文字自身数值为变量x，形如x-0.05、(x^2-1)/2"
   
10.   )
    
11.   (setq ws (getint "\n请输入小数点后位数<3>"))
    
12.   (if (not ws)
    
13.     (setq ws 3)
    
14.   )
    
15.   (prompt "\n选择需要数值运算的文字")
    
16.   (setq ss (ssget (list (cons 0 "TEXT"))))
    
17.   ;_(svos)
    
18.   (if
    
19.     (and ss
    
20.    (setq ssen (ss2lst ss nil))
    
21.    (setq ssen (vl-remove-if-not
    
22.           (function  (lambda  (x)
    
23.           (numberp (read (dxf 1 x)))
    
24.         )
    
25.           )
    
26.           ssen
    
27.         )
    
28.    )
    
29.     )
    
30.      (if
    
31.        (and (setq cal_str (vl-string-trim " " (LM:GetString "x-0.05")))
    
32.       (/= cal_str "")
    
33.        )
    
34.   (foreach a ssen
    
35.     (setq  ent (entget a)
    
36.     str (dxf 1 ent)
    
37.     x   (atof str)
    
38.     )
    
39.     (if x
    
40.       (setq x (vl-catch-all-apply (function cal) (list cal_str)))
    
41.     )
    
42.     (if (vl-catch-all-error-p x)
    
43.       (princ (vl-catch-all-error-message x))
    
44.       (progn
    
45.         (setq str (rtos x 2 ws))
    
46.         (setq ent (ch-en (cons 1 str) ent))
    
47.         (entmod ent)
    
48.       )
    
49.     )
    
50.   )
    
51.   (princ "\n未输入表达式")
    
52.      )
    
53.      (princ "\n选择错误.")
    
54.   )
    
55.   ;_(clos)
    
56.   (princ)
    
57. )
    
58. ;;;by Lee Mac
    
59. (defun LM:GetString (#Default / dcTag result)
    
60.   (cond (  (<= (setq dcTag (load_dialog "ACAD")) 0))
    
61.         (  (not (new_dialog "acad_txtedit" dcTag)))
    
62.         (t
    
63.            (set_tile "text_edit" #Default)
    
64.            (action_tile "accept" "(setq result (get_tile "text_edit")) (done_dialog)")
    
65.            (action_tile "cancel" "(done_dialog)")
    
66.            (start_dialog)
    
67.            (unload_dialog dcTag)))
    
68.   result)
    
69. ;;;转换选择集为表
    
70. (defun ss2lst (ss vla / a e i)
    
71.   (if (= (type ss) (quote PICKSET))
    
72.     (progn
    
73.       (setq i -1)
    
74.       (while (setq e (ssname ss (setq i (1+ i))))
    
75.   (if vla
    
76.     (setq e (vlax-ename->vla-object e))
    
77.     nil
    
78.   )
    
79.   (setq a (cons e a))
    
80.       )
    
81.     )
    
82.     nil
    
83.   )
    
84. )
    
85. ;;索引点表值
    
86. (defun dxf (co en)
    
87.   (if(eq(type en)(quote ENAME))(setq en(entget en(quote("*")))))
    
88.   (if(vl-consp co)(mapcar (function (lambda (x)(cdr (assoc x en))))co)
    
89.     (cdr (assoc co en))))
    
90. ;;点表替换
    
91. (defun ch-en (co en /)
    
92.   (if (eq (type en) (quote ename))
    
93.     (setq en (entget en (list "*")))
    
94.   )
    
95.   (if (assoc (car co) en)
    
96.     (subst co (assoc (car co) en) en)
    
97.     (reverse (cons co (reverse en)))
    
98.   )
    
99. )

(vl-load-com)<br /> ;;加载geomcal.arx<br /> (if (not(member "GEOMCAL.ARX" (mapcar (function strcase) (arx))))<br />     (arxload (findfile "geomcal.arx"))    <br />     )<br /> (defun c:szys (/ ws ss ssen cal_str ent str x)<br />   (prompt<br />     "\n计算表达式文字自身数值为变量x，形如x-0.05、(x^2-1)/2"<br />   )<br />   (setq ws (getint "\n请输入小数点后位数<3>"))<br />   (if (not ws)<br />     (setq ws 3)<br />   )<br />   (prompt "\n选择需要数值运算的文字")<br />   (setq ss (ssget (list (cons 0 "TEXT"))))<br />   ;_(svos)<br />   (if<br />     (and ss<br />    (setq ssen (ss2lst ss nil))<br />    (setq ssen (vl-remove-if-not<br />           (function  (lambda  (x)<br />           (numberp (read (dxf 1 x))) <br />         )<br />           )<br />           ssen<br />         )<br />    )<br />     )<br />      (if<br />        (and (setq cal_str (vl-string-trim " " (LM:GetString "x-0.05")))<br />       (/= cal_str "")<br />        )<br />   (foreach a ssen<br />     (setq  ent (entget a)<br />     str (dxf 1 ent)<br />     x   (atof str)<br />     )<br />     (if x<br />       (setq x (vl-catch-all-apply (function cal) (list cal_str)))<br />     )<br />     (if (vl-catch-all-error-p x)<br />       (princ (vl-catch-all-error-message x))<br />       (progn<br />         (setq str (rtos x 2 ws))<br />         (setq ent (ch-en (cons 1 str) ent))<br />         (entmod ent)<br />       )<br />     )<br />   )<br />   (princ "\n未输入表达式")<br />      )<br />      (princ "\n选择错误.")<br />   )<br />   ;_(clos)<br />   (princ)<br /> )<br /> ;;;by Lee Mac <br /> (defun LM:GetString (#Default / dcTag result)<br />   (cond (  (<= (setq dcTag (load_dialog "ACAD")) 0))<br />         (  (not (new_dialog "acad_txtedit" dcTag)))<br />         (t<br />            (set_tile "text_edit" #Default)<br />            (action_tile "accept" "(setq result (get_tile "text_edit")) (done_dialog)")<br />            (action_tile "cancel" "(done_dialog)")<br />            (start_dialog)<br />            (unload_dialog dcTag)))<br />   result)<br /> ;;;转换选择集为表<br /> (defun ss2lst (ss vla / a e i)<br />   (if (= (type ss) (quote PICKSET))<br />     (progn<br />       (setq i -1)<br />       (while (setq e (ssname ss (setq i (1+ i))))<br />   (if vla<br />     (setq e (vlax-ename->vla-object e))<br />     nil<br />   )<br />   (setq a (cons e a))<br />       )<br />     )<br />     nil<br />   )<br /> )<br /> ;;索引点表值<br /> (defun dxf (co en)<br />   (if(eq(type en)(quote ENAME))(setq en(entget en(quote("*")))))<br />   (if(vl-consp co)(mapcar (function (lambda (x)(cdr (assoc x en))))co) <br />     (cdr (assoc co en))))<br /> ;;点表替换<br /> (defun ch-en (co en /)<br />   (if (eq (type en) (quote ename))<br />     (setq en (entget en (list "*")))<br />   )<br />   (if (assoc (car co) en)<br />     (subst co (assoc (car co) en) en)<br />     (reverse (cons co (reverse en)))<br />   )<br /> )

freeok

大师 之作，看不懂。。