带有字符的数值求和
如图，希望能实现点选红色框的文字，实现求和.
;加152 加152
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget ":E:S" '((0 . "TEXT")))) (progn
(setq txt (cdr(assoc 1 (entget (ssname ss 0)))))
(if (wcmatch txt "*加*") (progn
(while (setq n (vl-string-search "加" txt))
(if (= n 0)
(setq txt (strcat (substr txt (+ n 3))))
(setq txt (strcat (substr txt 1 n) " " (substr txt (+ n 3))))
)
)
(setq ntxt (rtos (apply '+ (read(strcat "(" txt ")"))) 2))
(if (setq pt1 (getpoint "\n结果放置点: "))
(command "TEXT" pt1 "" "" ntxt)
)
))
))
(setvar "CMDECHO" 1)
(princ)
)
ZZXXQQ 发表于 2015-10-24 13:15 static/image/common/back.gif
并不能用。而且你的只支持“加”开头的。我已经找到了能用的了。不过还是谢谢你。 ZZXXQQ 发表于 2015-10-24 13:15 static/image/common/back.gif
;;;;;;**************************************框选数字结尾文本求和
(defun c:qh(/ all endno aa bb cc wz tha tsum i)
(if (null xzz) (setq xzz 0))
(yy-emk-yb)
(setq ALL (ssget(list (cons 0 "text"))))
(if all (SETQ nn (SSLENGTH ALL)))
(setq endno 0)
(setq tsum 0 i 0)
(WHILE (and(< endno nn) all)
(setq aa (ssname all endno))
(setq bb (entget aa))
(setq zggg (cdr (assoc 40 bb)))
(setq cc(cdr(assoc 1 bb)))
(setq wz(rdata cc))
(setq tha(substr cc (+ wz 1) ( - (strlen cc) wz -1)))
(if (= tha "") (setq tha "0"))
(setq tsum(+ tsum (atof tha)))
(setq i(1+ i))
(print (strcat (itoa i) ":文本 <" cc ">---数字 <" tha ">"))
(setq endno (+ endno 1))
)
(print (strcat "共" (itoa i) "个文本，和=" (rtos tsum)))
(setq rk (rtos tsum))
(SETQ PO (getpoint "\n指定文本输出位置:"))
(COMMAND "TEXT" PO zggg 0 rk)
(print)
)
(defun yy-emk-yb nil
(if (not (tblobjname "Style" "公司标准"))
(entmake
'((0 . "Style")(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "公司标准")(70 . 0)(40 . 0)(41 . 0.8)(50 . 0)(71 . 0)
(42 . 0)(3 . "hztxt_e.shx")(4 . "hztxt.shx"))
)
)
(setvar "TextStyle" "公司标准")
(princ)
)
;;;
(defun rdata(str / len i aa)
(if (> (strlen str) 0)
(progn
(setq i (strlen str))
(setq aa(substr str (strlen str) 1))
(while (and (or (and (>= aa "0") (<= aa "9"))
(= aa ".")
)
(>= i 1)
)
(setq i(1- i))
(if (>= i 1) (setq aa(substr str i 1)))
)
)
)
(setq i i)
) ZZXXQQ 发表于 2015-10-24 13:15 static/image/common/back.gif
像这种能不能实现点选求和？成8+加7+墙4+钉9+管5+引4+接8
;;;;;;**************************************框选数字结尾文本求和
(defun c:qh(/ all endno aa bb cc wz tha tsum i)
(if (null xzz) (setq xzz 0))
(yy-emk-yb)
(setq ALL (ssget(list (cons 0 "text"))))
(if all (SETQ nn (SSLENGTH ALL)))
(setq endno 0)
(setq tsum 0 i 0)
(WHILE (and(< endno nn) all)
(setq aa (ssname all endno))
(setq bb (entget aa))
(setq zggg (cdr (assoc 40 bb)))
(setq cc(cdr(assoc 1 bb)))
(setq wz(rdata cc))
(setq tha(substr cc (+ wz 1) ( - (strlen cc) wz -1)))
(if (= tha "") (setq tha "0"))
(setq tsum(+ tsum (atof tha)))
(setq i(1+ i))
(print (strcat (itoa i) ":文本 <" cc ">---数字 <" tha ">"))
(setq endno (+ endno 1))
)
(print (strcat "共" (itoa i) "个文本，和=" (rtos tsum)))
(setq rk (rtos tsum))
(SETQ PO (getpoint "\n指定文本输出位置:"))
(COMMAND "TEXT" PO zggg 0 rk)
(print)
)
(defun yy-emk-yb nil
(if (not (tblobjname "Style" "公司标准"))
(entmake
'((0 . "Style")(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "公司标准")(70 . 0)(40 . 0)(41 . 0.8)(50 . 0)(71 . 0)
(42 . 0)(3 . "hztxt_e.shx")(4 . "hztxt.shx"))
)
)
(setvar "TextStyle" "公司标准")
(princ)
)
;;;
(defun rdata(str / len i aa)
(if (> (strlen str) 0)
(progn
(setq i (strlen str))
(setq aa(substr str (strlen str) 1))
(while (and (or (and (>= aa "0") (<= aa "9"))
(= aa ".")
)
(>= i 1)
)
(setq i(1- i))
(if (>= i 1) (setq aa(substr str i 1)))
)
)
)
(setq i i)
) 顶楼上，支持12m+15m+18m这样的求和更好 果然强大啊。谢谢分享。 支持12m+15m+18m这样的求和更好 楼主很强大啊。
页:
[1]
2