获取XY平面内任意个顶点构成的封闭多边形面积

fangmin723

CAD官方自带了(vla-get-Area obj) (command AREA)来获取面积，
但vla-get-Area需现有个对象才行，
command呢，需要考虑捕捉的问题

1. 出自明经 AutoLISP 编程②群 @必强 大佬
   
2. (and
   
3.   (setq en (entsel))
   
4.   (vl-cmdf "area" "o"(car en ) ""  "" "" )
   
5.   (alert (rtos(getvar 'area)))
   
6. )
   

出自明经 AutoLISP 编程②群 @必强 大佬<br /> (and<br />   (setq en (entsel))<br />   (vl-cmdf "area" "o"(car en ) ""  "" "" )<br />   (alert (rtos(getvar 'area)))<br /> )<br />

上述代码也需要对象
如果想要获取如下如所示的部分面积，按照上述两种方法，
要么需要对象，要么需要考虑捕捉的问题


所以，写了按照顶点表获取面积的函数，如下：

1. ;;说明:获取封闭多边形面积
   
2.   ;;参数:ptlst:按参数排序点的表
   
3.   ;;返回:多边形的面积
   
4.   (defun polygonarea(ptlst / area pt1 pt2 pts)
   
5.     (if(> (length ptlst) 2)
   
6.       (progn
   
7.         (setq pt1 (car ptlst) pts pt1 ptlst (cdr ptlst) area 0)
   
8.         (while (setq pt2 (car ptlst))
   
9.           (setq area (+ area (- (* (car pt1) (cadr pt2)) (* (cadr pt1) (car pt2)))))
   
10.           (setq pt1 pt2 ptlst (cdr ptlst))
    
11.         )
    
12.         (setq area (* 0.5 (+ area (- (* (car pt1) (cadr pts)) (* (cadr pt1) (car pts))))))
    
13.         (abs area)
    
14.       )
    
15.       0
    
16.     )
    
17.   )

;;说明:获取封闭多边形面积<br />   ;;参数:ptlst:按参数排序点的表<br />   ;;返回:多边形的面积<br />   (defun polygonarea(ptlst / area pt1 pt2 pts)<br />     (if(> (length ptlst) 2)<br />       (progn<br />         (setq pt1 (car ptlst) pts pt1 ptlst (cdr ptlst) area 0)<br />         (while (setq pt2 (car ptlst))<br />           (setq area (+ area (- (* (car pt1) (cadr pt2)) (* (cadr pt1) (car pt2)))))<br />           (setq pt1 pt2 ptlst (cdr ptlst))<br />         )<br />         (setq area (* 0.5 (+ area (- (* (car pt1) (cadr pts)) (* (cadr pt1) (car pts))))))<br />         (abs area)<br />       )<br />       0<br />     )<br />   )

1. (defun c:GetPolygonArea(/ ent polygonarea)
   
2.   (if (setq ent (car (entsel)))
   
3.     (princ
   
4.       (rtos
   
5.         (polygonarea
   
6.           (mapcar
   
7.             'cdr
   
8.             (vl-remove-if-not '(lambda(x) (= 10 (car x)))
   
9.               (entget ent)
   
10.             )
    
11.           )
    
12.         ) 2 2
    
13.       )
    
14.     )
    
15.   )
    
16.   (prin1)
    
17. )

(defun c:GetPolygonArea(/ ent polygonarea)<br />   (if (setq ent (car (entsel)))<br />     (princ <br />       (rtos <br />         (polygonarea <br />           (mapcar <br />             'cdr <br />             (vl-remove-if-not '(lambda(x) (= 10 (car x))) <br />               (entget ent)<br />             )<br />           )<br />         ) 2 2<br />       )<br />     )<br />   )<br />   (prin1)<br /> )

fangmin723

注意，有z值的，或不闭合的可能数据不符

hubeiwdlue

用纯数学方法写得函数，就是让人敬佩。