关于求面积

xueer

如果有一个闭合实体，怎么求它的面积？


如果是一个点表，又怎么求它围成的面积？


是否都有直接得到面积的函数呢？

lockmyeye

如何在LISP中实现对一封闭的多义线或圆实现求面积呀？http://bbs.mjtd.com/forum.php?mod=viewthread&tid=31070 有点表，如何获取面积 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=12761

xueer

谢谢楼上的这位，另外还有个问题噢


在一区域内拾取一个点，然后获取这个闭合区域的各个顶点，这个区域可能是多条线交叉围成的，我记得可以用boundary，可接下来具体是怎么实现呢？还有我想让这个区域高亮显示，以便于判断它是否我想要的区域

xueer

对了，还有个问题，呵呵，别嫌烦噢


就是对list怎么用max，(max 1 2 3 4), 而list却包含括号，不能用.

ljpnb

xueer发表于2005-3-24 10:12:00对了，还有个问题，呵呵，别嫌烦噢 就是对list怎么用max，(max 1 2 3 4), 而list却包含括号，不能用.

(max '1 '2 '3 '4)

meflying

(setq lst (1 2 3 4))


(apply 'max lst)

xueer

谢谢楼上的几位，另外还有个问题噢



在一区域内拾取一个点，然后获取这个闭合区域的各个顶点，这个区域可能是多条线交叉围成的，我记得可以用boundary，可接下来具体是怎么实现呢？还有我想让这个区域高亮显示，以便于判断它是否我想要的区域

lockmyeye

1.    (DEFUN c:test ()
2.        (IF (SETQ pt (GETPOINT "\n选择区域位置:"))
3.                (PROGN (SETQ ent_last (ENTLAST))
4.                              (COMMAND "boundary" pt "")
5.                              (IF (NOT (EQUAL (ENTLAST) ent_last))
6.                                      (PROGN (REDRAW (ENTLAST) 3)       ;高亮显示
7.                                                    (INITGET "Yes No")           ;确认是否这一区域
8.                                                    (IF (= "No" (GETKWORD "\n是这个区域吗?[Y(是)/N(否)]:"))
9.                                                            (COMMAND "undo" "1")
10.                                                    )
11.                                                    (REDRAW (ENTLAST) 4)       ;取消高亮显示
12.                                      )
13.                                      (PRINC "\n无法确定边界。")
14.                              )
15.                )
16.        )
17.        (PRINC)
18. )

复制代码

舟自横

楼上版主的想法有一个BUG,如果在一个封闭图形中还有一个或多个封闭的图形,那样只返回最外形框的面积而不能取得除去中间孤岛后的真实面积,我曾经写了这样一来一个程序,是用来计算铣加工体积的,有排除孤岛的功能! (defun c:volm(/ p1 p2 ssa sst j sstx sstname area deep enaa item maxarea addarea
qq emdh);;;计算铣深积
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "ucs" "w")
(setq p1 (getpoint "\n选取需要计算面域内一点(图元内最好无其他图元):")
p2 (polar p1 (* 0.25 pi) 0.5))
(setq i 0)
(setq enaa nil)
(while (not enaa)
(foreach item (ap-sslist (ssget "f" (list p1 p2)))
(if (OR (= "LINE" (cdr (assoc 0 (entget item))))
(= "LWPOLYLINE" (cdr (assoc 0 (entget item))))
(= "POLYLINE" (cdr (assoc 0 (entget item))))
(= "ARC" (cdr (assoc 0 (entget item))))
(= "REGION" (cdr (assoc 0 (entget item)))))
(SETQ enaa item)) ;(command "erase" item ""))
)
;(not (ssget "f" (list p1 p2))))
(setq i (1+ i)) (if (> i 4000) (exit))
(setq p2 (polar p2 (* 0.25 pi) 0.5))
)
(if (= "REGION" (cdr (assoc 0 (entget enaa))))
(progn (command "explode" enaa "") (hy_apline (entlast)))
)
(setq ena (entlast))
(command "bpoly" p1 "")
(setq sst (ap-after ena));;;;;;最后生成的所有图元
(setq qq 0)
(repeat (sslength sst)
(setq emdh (ssname sst qq))
(if (= "REGION" (cdr (assoc 0 (entget emdh))))
(ssdel emdh sst)
)
(setq qq (1+ qq))
)
(setq j 0)
(setq sstx (ssadd))
(repeat (sslength sst)
(setq sstname (ssname sst j))
(if (vlax-curve-isclosed (vlax-ename->vla-object sstname))
(setq sstx (ssadd sstname sstx))
)
(setq j (1+ j))
)
(setq k 0)
(setq maxarea 0)
(setq addarea 0)
(repeat (sslength sstx)
(setq addarea (+ (vla-get-area(vlax-ename->vla-object (ssname sstx k))) addarea))
(if (> (vla-get-area(vlax-ename->vla-object (ssname sstx k))) mazrea)
(setq maxarea (vla-get-area(vlax-ename->vla-object (ssname sstx k))))
)
(setq k (1+ k))
)
(setq area (- maxarea (- addarea maxarea)))
(foreach item (ap-sslist sstx) (vla-put-color (vlax-ename->vla-object item) 50))
(command "hatch" "s" sstx "")(setq sstx (ssadd (entlast) sstx))
(setq deep nil)
(while (not deep)
(setq deep (getreal "\n请输入深度:")))
(alert (strcat "\n你选取部分的体积为:" (rtos (* deep area) 2 3)))
(command "erase" sstx "")
(prin1)
)
其中有调用一些公共函数一起奉上!大家可以交流一下是否还有更方便的办法! (defun hy_apline(ename1 / vla-obj endpoint ename startpoint i ss1 nn ssm ssn itemx);;;选择一条线串接与之相联的图元为多义线
(if (= "LWPOLYLINE" (cdr(assoc 0 (entget ename1)))) (command "._explode" ename ""))
(setq ename (entlast))
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
;(safearray-value(vlax-variant-value(vla-get-endpoint vla-obj))))
(if (OR (= "POLYLINE" (cdr(assoc 0 (entget ename))))
(= "LWPOLYLINE" (cdr(assoc 0 (entget ename)))))
(setq i 1)(SETQ I 0))
(setq j 0);;计数器归0
(setq nn 0)
(princ " ─── \r")
(while (> (distance startpoint endpoint) 0.0000001);(= (vla-get-closed vla-obj) :vlax-false)
;(setq ss1 (ssget "x" (list (cons -4 "<or") (cons 10 endpoint)(cons 11 endpoint) (cons -4 "or>"))))
(setq ss1 (ssadd))
(setq ssn (ssget "f" (list endpoint (polar endpoint 0.8 0.1))))
(foreach itemx (ap-sslist ssn)
(if (or (< (distance endpoint (vlax-curve-getstartpoint (vlax-ename->vla-object itemx))) 0.0000001)
(< (distance endpoint (vlax-curve-getendpoint (vlax-ename->vla-object itemx))) 0.0000001))
(setq ss1 (ssadd itemx ss1))
)
)
(setq ss2 (ssadd))
(setq ssm (ssget "f" (list startpoint (polar startpoint 0.8 0.1))))
(foreach itemx (ap-sslist ssm)
(if (or (< (distance startpoint (vlax-curve-getstartpoint (vlax-ename->vla-object itemx))) 0.0000001)
(< (distance startpoint (vlax-curve-getendpoint (vlax-ename->vla-object itemx))) 0.0000001))
(setq ss2 (ssadd itemx ss2))
)
)
(setq ssg (addss ss1 ss2))
(if (= 0 i)(command "pedit" ename "y" "j" ssg "" "")
(command "pedit" ename "j" ssg "" ""))
(setq ename (entlast))
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
(setq i (1+ i))
(setq nn (1+ nn))
(cond ((= nn 15)(princ (strcat "线很长..正在串接中,请稍侯 ...... ───" "\r")))
((= nn 30)(princ (strcat "线很长..正在串接中,请稍侯 ...... ﹨﹨﹨" "\r")))
((= nn 45)(princ (strcat "线很长..正在串接中,请稍侯 ...... │││" "\r")))
((= nn 60)(princ (strcat "线很长..正在串接中,请稍侯 ...... ∕∕∕" "\r")))
)
(if (> nn 60) (setq nn 1))
(setq j (1+ j))
(IF (and (= 1 (sslength ssg))(= (vla-get-closed vla-obj) :vlax-false))
(setq startpoint '(0 0 0) endpoint '(0 0 0)));(alert "\n请注意!****串接不线不能封闭!")
)
(if (> j 1000)(prompt (strcat "\n恭喜你一共把" (itoa (+ (* 2 j) 3)) "条线串接成了一个封闭的復线!")))
)