【悬赏活动2】求封闭区域的面积、形心和周长

;;
;;功能：增强表达式的计算
;;文件：calu.lsp
;;命令：ca或'ca透明调用
;;使用：增强支持符号 %=百分比 T=取文字数值 S=取对象面积 L=取对象长度 C=使用计算器
;; 整数运算不受32767的限制
;; 对表达式预运算避免图面取点后再提示错误
;;作者：YAD
;;

(defun c:ca(/ str_replace str_dis get_val ~e ~str ~oldstr ~test ~tsl ~n ~tn ~sn ~ln ~strnew ~txt ~pt ~ss ~ent)
(defun str_replace(st sty val / str tmp n txt end)
(cond
((= sty "num")
(setq str "" tmp "" n 0)
(repeat (strlen st)
(setq txt (substr st (setq n (1+ n)) 1))
(if (wcmatch txt "#,`.")
(setq tmp (strcat tmp txt))
(progn
(if (/= tmp "")
(setq tmp (if (wcmatch tmp "*`.*") tmp (strcat tmp ".")) str (strcat str tmp) tmp "")
)
(setq str (strcat str (if (= txt "%") "/100.0" txt)))
)
)
)
(if (/= tmp "")
(setq tmp (if (wcmatch tmp "*`.*") tmp (strcat tmp ".")) str (strcat str tmp))
)
)
((= sty "test")
(foreach itm '("END" "INS" "INT" "MID" "CEN" "NEA" "NOD" "QUA" "PER" "TAN" "CUR" "ILLE" "MEE" "NEE" "VEE")
(while (wcmatch st (strcat "*" itm "*")) (setq st (vl-string-subst val itm st)))
)
(foreach itm '("RAD" "DEE")
(while (wcmatch st (strcat "*" itm "*")) (setq st (vl-string-subst "1" itm st)))
)
(setq str st)
)
((= sty "T,S,L")
(setq str "" n 0)
(repeat (strlen st)
(setq txt (substr st (setq n (1+ n)) 1))
(if (and (wcmatch txt sty) (or (= n 1) (member (substr st (1- n) 1) '("+" "-" "*" "/" "(")))
(member (substr st (1+ n) 1) '("+" "-" "*" "/" "^" ")" ""))
)
(setq str (strcat str val) ~tsl T)
(setq str (strcat str txt))
)
)
)
(T
(setq str "" n 0)
(repeat (strlen st)
(setq txt (substr st (setq n (1+ n)) 1))
(if (and (not end) (= txt sty) (or (= n 1) (member (substr st (1- n) 1) '("+" "-" "*" "/" "(")))
(member (substr st (1+ n) 1) '("+" "-" "*" "/" "^" ")" ""))
)
(setq str (strcat str val) end T)
(setq str (strcat str txt))
)
)
)
)
str
)
(defun str_dis(val)
(if (and (= (type val) 'real) (> val 999999.0)) (rtos val) (vl-princ-to-string val))
)
(defun get_val(txt / str2num ss n m ent val)
(defun str2num(str / e n st st1 st2)
(setq e T n 0)
(while (and e (/= "" (setq st (substr str (setq n (1+ n)) 1))))
(if (wcmatch st "#")
(setq st1 (if (> n 1) (substr str (1- n) 1) "a")
st2 (if (> n 2) (substr str (- n 2) 1) "b")
str (substr str n)
e nil
)
)
)
(if (wcmatch str "*#*")
(progn
(setq e T n 0)
(while (and e (/= "" (setq st (substr str (setq n (1+ n)) 1))))
(if (not (wcmatch st "#,`."))
(setq str (substr str 1 (1- n)) e nil)
)
)
(if (= st1 "-")
(setq str (strcat st1 str))
(if (= st1 ".")
(if (= st2 "-")
(setq str (strcat st2 st1 str))
(setq str (strcat st1 str))
)
)
)
)
)
(if (= st "%")
(/ (atof str) 100)
(atof str)
)
)
(prompt (strcat "\nYAD>> 计算表达式: " ~oldstr "\n>> 给第"
(itoa (cond ((= txt "T") (setq ~tn (1+ ~tn))) ((= txt "S") (setq ~sn (1+ ~sn))) ((= txt "L") (setq ~ln (1+ ~ln)))))
"个" txt "符号选择对象！"
)
)
(if (setq ss (ssget (list (cons 0 (cond ((= txt "T") "text")
((= txt "S") "arc,circle,ellipse,lwpolyline,spline")
((= txt "L") "arc,circle,ellipse,line,lwpolyline,spline")
))))
)
(progn
(setq n -1 m 0)
(repeat (sslength ss)
(setq ent (ssname ss (setq n (1+ n))))
(cond
((= txt "T")
(setq val (str2num (cdr (assoc 1 (entget ent)))))
)
((= txt "S")
(setq val (vla-get-Area (vlax-ename->vla-object ent)))
)
((= txt "L")
(setq ent (vlax-ename->vla-object ent))
(setq val (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
)
)
(setq m (+ m val))
)
)
(setq m 0)
)
(prompt (strcat "\n>> 第" (itoa (cond ((= txt "T") ~tn) ((= txt "S") ~sn) ((= txt "L") ~ln))) "个" txt "=" (str_dis m)))
(rtos m 2 6)
)
(if (not cal) (arxload "geomcal.arx"))
(setvar "cmdecho" 0)
(prompt "\n**遵照标准数学表达式和优先级计算规则计算\n**增强支持符号：%=百分比 T=取文字数值 S=取对象面积 L=取对象长度 C=使用计算器")
(setq ~e T ~str nil)
(while (and ~e (/= ~str "C") (/= (setq ~str (strcase (setq ~oldstr (getstring "\nYAD>> 计算表达式: ")))) ""))
(setq ~str (str_replace ~str "num" ".") ~test (str_replace ~str "T,S,L" "1"))
(cond
((= ~str "C") (startapp "calc.exe"))
((not (cal (str_replace ~test "test" "[1,1,1]"))))
(T
(if ~tsl
(progn
(setq ~n 0 ~tn 0 ~sn 0 ~ln 0 ~strnew ~str)
(repeat (strlen ~str)
(setq ~txt (substr ~str (setq ~n (1+ ~n)) 1))
(if (and (member ~txt '("T" "S" "L")) (or (= ~n 1) (member (substr ~str (1- ~n) 1) '("+" "-" "*" "/" "(")))
(member (substr ~str (1+ ~n) 1) '("+" "-" "*" "/" "^" ")" ""))
)
(setq ~strnew (str_replace ~strnew ~txt (get_val ~txt)))
)
)
(setq ~str ~strnew)
)
)
(if (setq ~str (cal ~str))
(progn
(if (/= (getvar "cmdnames") "") (setq ~e nil))
(prompt (strcat "\nYAD>> 计算表达式: " ~oldstr "\n>> 结果: " (str_dis ~str)))
(if ~tsl
(progn
(setq ~tsl nil ~n -1)
(if (setq ~pt (getpoint "\n点取标注位置： <文字替换> "))
(entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 ~pt)
(cons 40 (getvar "textsize")) (cons 1 (rtos ~str)) (cons 100 "AcDbText")
)
)
(if (setq ~ss (ssget '((0 . "text"))))
(repeat (sslength ~ss)
(setq ~ent (entget (ssname ~ss (setq ~n (1+ ~n)))))
(entmod (subst (cons 1 (rtos ~str)) (assoc 1 ~ent) ~ent))
)
)
)
)
)
)
)
)
)
)
(if (= (getvar "cmdnames") "")
(princ)
(progn (princ "\n") ~str)
)
)











网上的 但是不能标注出来 只能标注“0 ” 请问大师可以修改一下吗

十分感谢

请教是否可以把 面积 周长 直接自己自动标注在图纸之中，而同时显示在命令行，请问应该把上面的 lsp 文件如何修改

不胜感激！！！！！！！

要是可以劳烦您发一个到 whereiswill@163.com 就是阿弥陀佛了:)