求多段线图形的面积 长度标注
如何利用 list 列表命令得到面积及长度,并标注在图形上 也可以输出到EXCEL文件下面是一段从网上得到的程序,不知如何修改
;;; AREAM.LSP
;;; Function: Calculates the total area of selected objects
(defun c:aream(/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
(defun errexit (s)
(restore)
)
(defun undox ()
(command ._undo _E)
(setvar cmdecho oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar cmdecho))
(setvar cmdecho 0)
(command ._UNDO _BE)
(if (setq ss1 (ssget \'((-4 . <OR)
(0 . POLYLINE)
(0 . LWPOLYLINE)
(0 . CIRCLE)
(0 . ELLIPSE)
(0 . SPLINE)
(0 . REGION)
(-4 . OR>)
)
)
)
(progn
(setq nr 0)
(setq tot_area 0.0)
(setq en (ssname ss1 nr))
(while en
(command ._area _O en)
(setq tot_area (+ tot_area (getvar area)))
(setq nr (1+ nr))
(setq en (ssname ss1 nr))
)
(princ \\nTotal Area = )
(princ tot_area)
)
)
(restore)
)
;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ d ent f i lst m2 obj pt ss txt x y)
(setq TextHeight (getdist "\n输入标注文字高度:"))
(defun maketext (txt pt) ; 生成文字子函数
(entmake (list '(0 . "TEXT") (cons 62 1) (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)))
)
(setvar "cmdecho" 0)
(vl-load-com)
(setq ss (ssget) ent (entlast))
(command ".region" ss "")
(setq ss (ssadd)lst nil)
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (entget ent))) "REGION")
(setq obj (vlax-ename->vla-object ent) pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))
m2 (rtos (vla-get-area obj) 2 2) d (rtos (vla-get-perimeter obj) 2 2) lst (cons (list pt m2 d) lst)
)
)
)
(command ".undo" "")
(setq lst (vl-sort lst (function (lambda (x y)(< (car (car x)) (car (car y)))))))
(setq lst (vl-sort lst (function (lambda (x y)(> (cadr (car x)) (cadr (car y)))))))
(setq f (getfiled "指定输出文件路径" "" "xls" 1) f (open f "w"))
(write-line "编号\t周长(mm)\t面积(mm2)" f)
(setq i 1)
(foreach x lst
(setq pt (car x) m2 (cadr x) d (caddr x))
(maketext (strcat "A" (itoa i)) (list (car pt) (+ (cadr pt) 20)))
(maketext (strcat "L=" d "mm") pt)
(maketext (strcat "S=" m2 "mm2") (list (car pt) (- (cadr pt) 14)))
(write-line (strcat (strcat "A" (itoa i)) "\t" d "\t" m2) f)
(setq i (1+ i))
)
(close f)
(princ)
论坛里有了，自己找。 香田里浪人 发表于 2013-1-20 20:51 static/image/common/back.gif
;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ d ...
老师你这个怎么用不起来 664571221 发表于 2015-12-21 11:25 static/image/common/back.gif
老师你这个怎么用不起来
那就试试这个，应该可以用
;;;面积批量计算
(defun c:mjjs (/ ss j length1 m ent zbc i sum x y n2 cx cy x1 x2 p1 p3 p4 pt area)
(setvar "cmdecho" 0)
(vl-load-com)
(setq TextHeight (getdist "\n请输入文字高度:(默认1)"))
(if (= TextHeight nil) (setq TextHeight 1))
(while
(setq ss (ssget (list (cons 0 "CIRCLE,LWPOLYLINE,ELLIPSE")))
length1 (- (sslength ss) 1)
j0
)
(while (>= length1 0)
(setq m (ssname ss length1)
ent (entget m)
zbc '()
i 1
sum 0
x 0
y 0
)
(foreach n1 ent
(if (= (nth 0 n1) 10)
(setq zbc (cons (cdr n1) zbc))
)
)
(foreach n2 zbc
(if (/= (rem i 2) 0)
(progn
(setq x1 (nth 0 n2)
y1 (nth 1 n2)
i(+ i 1)
)
(if (>= i 3)
(progn
(setq area (* (- (* x2 y1) (* x1 y2)) 0.500)
sum(+ sum area)
cx (* (- (* x2 y1) (* x1 y2)) (+ x2 x1))
cy (* (- (* x2 y1) (* x1 y2)) (+ y1 y2))
x (+ x cx)
y (+ y cy)
)
)
)
)
(progn
(setq x2 (nth 0 n2)
y2 (nth 1 n2)
area (* (- (* x1 y2) (* x2 y1)) 0.500)
sum(+ sum area)
cx (* (- (* x1 y2) (* x2 y1)) (+ x2 x1))
cy (* (- (* x1 y2) (* x2 y1)) (+ y1 y2))
i (+ i 1)
x (+ x cx)
y (+ y cy)
)
)
)
)
(if (= (rem i 2) 0)
(setq p1(nth 0 zbc)
x2(nth 0 p1)
y2(nth 1 p1)
area (* (- (* x1 y2) (* x2 y1)) 0.5)
sum(+ sum area)
cx(* (- (* x1 y2) (* x2 y1)) (+ x2 x1))
cy(* (- (* x1 y2) (* x2 y1)) (+ y1 y2))
x(+ x cx)
y(+ y cy)
)
(setq p1(nth 0 zbc)
x1(nth 0 p1)
y1(nth 1 p1)
area (* (- (* x2 y1) (* x1 y2)) 0.5)
sum(+ sum area)
cx(* (- (* x2 y1) (* x1 y2)) (+ x2 x1))
cy(* (- (* x2 y1) (* x1 y2)) (+ y1 y2))
x(+ x cx)
y(+ y cy)
)
)
(setq x(/ x (* sum 6))
y(/ y (* sum 6))
pt (list(- x 0.8) y)
p1 (list(+ x 0.8)y)
)
(setq sum (rtos (abs sum) 2 2)
length1 (- length1 1)
p3 (listx(+ y 0.3))
p4 (listx(- y 0.3))
j (+ j 1)
)
(setq sum (strcat "S=" sum"㎡"))
(command "layer" "M" "面积" "C" "6" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(command "text" "j" "m" p3 TextHeight 0 sum)
))
)
;;; 香田里浪人 发表于 2015-12-21 20:26 static/image/common/back.gif
那就试试这个，应该可以用
;;;面积批量计算
(defun c:mjjs (/ ss j length1 m ent zbc i sum x y n2 cx ...
老师，这个对圆和椭圆没有反应。 二楼，谢谢分享……
页:
[1]