(defun c:aa (/ m2 name obj pt pt1 pt2 ss textH)
(setq textH (getreal "\n输入新的文字高度<400>:"))
(setq textH (if (= textH nil)
400
textH
)
)
(setq ss (ssadd))
(setq pt1 (getpoint "\n按顺序选择封闭区域顶点："))
(while (setq pt2 (getpoint pt1 "\n按顺序选择封闭区域顶点："))
(entmake (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(62 . 1)
(cons 90 2)
(cons 10 pt1)
(cons 10 pt2)
)
)
(setq ss(ssadd (entlast) ss)
pt1 pt2
)
)
(command ".region" ss "")
(setq obj (vlax-ename->vla-object (setq name (entlast))))
(if (= (cdr (assoc 0 (entget name))) "REGION")
(progn
(setq pt (vlax-safearray->list
(vlax-variant-value (vla-get-centroid obj))
)
m2 (strcat "S=" (rtos (/(vla-get-area obj) 1000000.0) 2 2) "平方米")
)
(entmake (list '(0 . "TEXT")
(cons 62 3)
(cons 10 pt)
(cons 40 textH)
(cons 1 m2)
'(41 . 0.8)
'(72 . 1)
(cons 11 pt)
'(73 . 0)
)
)
(entdel name)
)
)
(command "erase" ss "")
(princ)
)从论坛里资料，学着改了一下，感觉面积加改成平方米能用了
面积计算很好，谢谢zhongzilei 兄，要是还能框选就ok了 正需要这方面的 非常好用！谢谢！ 非常好的代码， 谢谢分享啊。 这个编的真的太好了,不知道能不能把标注改成文本数字计算出表达方式呢
;;尺寸运算by:langjs
(defun c:qq ( / fuh i num obj ss str str1 tt)
(setq ss (ssget '((0 . "DIMENSION"))))
(setq fuh "+")
(while (not (member (setq tt (getstring (strcat "\n请输入运算符号[加(+)/乘(*)] <" fuh ">:")))'("*" "+" ""))))
(if (/= tt "") (setq fuh tt))
(if (= fuh "+")(setq num 0) (setq num 1))
(setq str "" i 0 )
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss i))
str1 (vla-get-measurement obj)
i (1+ i)
)
(if (= fuh "+")
(setq num (+ num str1)
str (strcat str (if (= i 1) "" "+") (rtos str1 2 3))
)
(setq num (* num str1)
str (strcat str (if (= i 1) "" "*") (rtos str1 2 3))
)
)
)
(entmake (list '(0 . "TEXT") (cons 1 (strcat str "=" (rtos num 2 3))) (cons 10 (getpoint "选择插入点"))
(cons 40 (*(vla-get-textheight obj)(vla-get-scalefactor obj)))
)
)
(princ)
) langjs 发表于 2012-11-7 13:03
;;尺寸运算by:langjs
(defun c:qq ( / fuh i num obj ss str str1 tt)
(setq ss (ssget '((0 . "DIME ...
你好能不能改成以m为单位
页:
1
[2]