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

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

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