[转帖]autocad中文本数字求和程序plus.lsp

<BR>;-----------------------------------------------------------------------------------------------<BR>;plus-&gt;文本计数求和;<BR>;v1.1 2004.1.对mtext的bug修正。消除重复符号;支持-.5写法,排除"写.法" ".." "+-"<BR>;功能：对选集中文本进行所有数字计算,支持一个text,mtext中有多个数字字符串,支持字符串中小数,负数:<BR>;返回: 有数字，数字相加后写文本，并返回求和数值(非字符串).无有效数字返回nil.<BR>;------------------------------------------------------------------------------------------------


(defun C:plus ( / ss filter mspace n e str asclst strs add pt txt txth)<BR>         (defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))<BR>         (princ "<BR>文本数字求和")<BR>         (vl-load-com)<BR>         (princ "<BR>选择要计算的文本(支持*TEXT选择集):")<BR>         (setq oerr *error*<BR>        ss (ssget '((0 . "*TEXT")))<BR>        filter "0123456789.-+"<BR>        mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))<BR>        str nil strs nil)<BR>         (if ss<BR>                         (repeat (setq n (sslength ss))<BR>                                         (x_draw ss 3)<BR>                                         (setq n (1- n)<BR>                                 e (ssname ss n)<BR>                                 str (vla-get-textstring(vlax-ename-&gt;vla-object e))<BR>                                 strs (strcat (if strs strs " ") (x_txt2 str) " ")) ;排除mtext bug.v1.1-2004.1<BR>                                         )<BR>                         )<BR>         (if (and ss (/= "" strs))<BR>                         (progn<BR>                                         (setq add (eval (read (strcat "(+ " strs ")")))) <BR>                                         (princ "<BR>文本数字和为: ")(princ add)<BR>                                         (if (setq pt (getpoint "<BR>标注位置&lt;重新计算&gt;:"))<BR>                 (progn<BR>                                                                                         (setq prec (getint "<BR>精度(小数位数):")<BR>                         txt (rtos add 2 prec)<BR>                         txth (getdist "<BR>字高:"))<BR>                                 (vla-addtext mspace txt (vlax-3D-point pt) txth)<BR>                                 (x_draw ss 4)<BR>                                 (princ) add)<BR>                 (progn (if ss (x_draw ss 4))(xtcal))         多次&lt;重新计算&gt;可以作为一个简易统计查看器.<BR>                                         )<BR>                         )<BR>                         (progn (princ "<BR>!空选集或文本中无有效数字!<BR>") nil)<BR>         )<BR>)<BR>;;<BR>(defun x_draw (ss key / n e)<BR>         (if (= 'PICKSET (type ss))<BR>                         (repeat (setq n (sslength ss))<BR>                                         (setq n (1- n)<BR>                                 e (ssname ss n))<BR>                                         (redraw e key)<BR>                         )<BR>         )<BR>)<BR>;;<BR>(defun x_txt2 (str / i key str1)<BR>         (setq i 1)<BR>         (repeat (strlen str)<BR>                 (cond<BR>                                 ((= "{\\f" (substr str i 3)) (setq i (+ 3 i) key T)) <BR>                                 ((and T (= "}" (substr str i 1))) (setq key nil))                 <BR>                                 ((not key)<BR>                                         (setq st (substr str i 1)<BR>                                                                                         str1 (strcat (if (not str1) "" str1) <BR>                                         (cond ((= "." st)(if (wcmatch (substr str (1+ i) 1) "#") st " "))<BR>                                                                         ((member st '("+" "-")) (if (wcmatch (substr str (1+ i) 1) "#,'.") st " "))<BR>                                                                         (T (if (wcmatch filter (strcat "*" st "*")) st " ")) <BR>                         )<BR>                         )))<BR>                 )<BR>                 (setq i (1+ i))<BR>         )<BR>         (setq str str1)<BR>) <BR>        <BR>       

非常有用!谢谢！

谢谢!