根据点表求点表构成多边形型心

XDSoft

1. ;| 多边形形心
   
2. 根据点表求点表构成多边形型心，不允许自交
   
3. 参数 pts ---- 点表
   
4. 返回值： 点
   
5. |;
   
6. (defun XD::Pnts:Centroid (pts / ar isum p0 p1 p2 pts1 x0 x1 x2 y0 y1 y2)
   
7.   (defun polygon_sumx (pts / pts1 isum p0 p1 p2 x0 x1 x2 y0 y1 y2)
   
8.     (setq pts1 pts)
   
9.     (setq isum 0
   
10.           p0 (car pts1)
    
11.           x0 (car p0)
    
12.           y0 (cadr p0)
    
13.     )
    
14.     (while (cdr pts1)
    
15.       (setq p1 (car pts1)
    
16.             x1 (car p1)
    
17.             y1 (cadr p1)
    
18.             p2 (cadr pts1)
    
19.             x2 (car p2)
    
20.             y2 (cadr p2)
    
21.             isum (+ isum (* (+ x1 x2) (- (* x1 y2) (* x2 y1))))
    
22.             pts1 (cdr pts1)
    
23.       )
    
24.     )
    
25.     (+ isum (* (+ (caar pts1) x0) (- (* (caar pts1) y0) (* x0 (cadar pts1)))))
    
26.   )
    
27.   (defun polygon_sumy (pts / pts1 isum p0 p1 p2 x0 x1 x2 y0 y1 y2)
    
28.     (setq pts1 pts)
    
29.     (setq isum 0
    
30.           p0 (car pts1)
    
31.           x0 (car p0)
    
32.           y0 (cadr p0)
    
33.     )
    
34.     (while (cdr pts1)
    
35.       (setq p1 (car pts1)
    
36.             x1 (car p1)
    
37.             y1 (cadr p1)
    
38.             p2 (cadr pts1)
    
39.             x2 (car p2)
    
40.             y2 (cadr p2)
    
41.             isum (+ isum (* (+ y1 y2) (- (* x1 y2) (* x2 y1))))
    
42.             pts1 (cdr pts1)
    
43.       )
    
44.     )
    
45.     (+ isum (* (+ (cadar pts1) y0) (- (* (caar pts1) y0) (* x0 (cadar pts1)))))
    
46.   )
    
47.   (setq ar (XD::Pnts:Area pts))
    
48.   (list (/ (polygon_sumx pts) (* 6 ar)) (/ (polygon_sumy pts) (* 6 ar)) 0.0)
    
49. )

;| 多边形形心<br /> 根据点表求点表构成多边形型心，不允许自交<br /> 参数 pts ---- 点表<br /> 返回值： 点<br /> |;<br /> (defun XD::Pnts:Centroid (pts / ar isum p0 p1 p2 pts1 x0 x1 x2 y0 y1 y2)<br />   (defun polygon_sumx (pts / pts1 isum p0 p1 p2 x0 x1 x2 y0 y1 y2)<br />     (setq pts1 pts)<br />     (setq isum 0<br />           p0 (car pts1)<br />           x0 (car p0)<br />           y0 (cadr p0)<br />     )<br />     (while (cdr pts1)<br />       (setq p1 (car pts1)<br />             x1 (car p1)<br />             y1 (cadr p1)<br />             p2 (cadr pts1)<br />             x2 (car p2)<br />             y2 (cadr p2)<br />             isum (+ isum (* (+ x1 x2) (- (* x1 y2) (* x2 y1))))<br />             pts1 (cdr pts1)<br />       )<br />     )<br />     (+ isum (* (+ (caar pts1) x0) (- (* (caar pts1) y0) (* x0 (cadar pts1)))))<br />   )<br />   (defun polygon_sumy (pts / pts1 isum p0 p1 p2 x0 x1 x2 y0 y1 y2)<br />     (setq pts1 pts)<br />     (setq isum 0<br />           p0 (car pts1)<br />           x0 (car p0)<br />           y0 (cadr p0)<br />     )<br />     (while (cdr pts1)<br />       (setq p1 (car pts1)<br />             x1 (car p1)<br />             y1 (cadr p1)<br />             p2 (cadr pts1)<br />             x2 (car p2)<br />             y2 (cadr p2)<br />             isum (+ isum (* (+ y1 y2) (- (* x1 y2) (* x2 y1))))<br />             pts1 (cdr pts1)<br />       )<br />     )<br />     (+ isum (* (+ (cadar pts1) y0) (- (* (caar pts1) y0) (* x0 (cadar pts1)))))<br />   )<br />   (setq ar (XD::Pnts:Area pts))<br />   (list (/ (polygon_sumx pts) (* 6 ar)) (/ (polygon_sumy pts) (* 6 ar)) 0.0)<br /> )

Highflybird

这个是我的方式：

[pcode=lisp,true];;;----------------------------------------------------;
;;;功能: 获取多边形信息(质心，面积，周长)              ;
;;;输入: Pts---多边形顶点列表                          ;
;;;输出: 列表:第一个为多边形的面积中心(质心),用2d点表示;
;;;      第二个为数值，正数表示多边形方向是CCW(逆时针) ;
;;;      负数表示顺时针；第三个为周长.                 ;
;;;参考: http://en.wikipedia.org/wiki/Centroid        ;
;;;----------------------------------------------------;
(defun POLY:Infomation (Pts / Pts1 Ai S lst cen)
  (setq Pts1 (MISC:1st->Last Pts))                      ;another point of every side
  (setq Ai   (mapcar 'MAT:Det2V Pts Pts1))              ;area of every side
  (setq S    (* (apply '+ Ai) 0.5))                     ;Total area
  (Setq Cen  (MAT:SxVs (mapcar 'MAT:v+v Pts Pts1) Ai))
  (setq Cen  (MAT:vxs Cen (/ 0.166666666666666667 S)))  ;base on the formula
  (list Cen S (apply '+ (mapcar 'distance pts pts1)))   ;Return Centroid,Total area and Perimeter
)[/pcode]

一些函数参见我的矩阵和关于几何计算的帖子：
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=667495&reltid=668705&pre_thread_id=0&pre_pos=1&ext=

XDSoft

Highflybird 发表于 2013-6-7 15:00
这个是我的方式：

;;;----------------------------------------------------;

这个要等这些矩阵和向量函数整理出来才能用，里面一些矩阵的习惯我认为需要调整下。

dwg001

(XD::Pnts:Area pts)  
－－－where

Free-Lancer

高飞版主的没有测试，LZ的程序获取的型心和用Region获取的有出入，不知是误差所致还是计算方法问题

Lispboy

dwg001 发表于 2013-6-7 16:40
(XD:nts:Area pts)  
－－－where

就在今天帖子里面，找找，更快的方式是点击 “函数发布” 链接。

XDSoft

Free-Lancer 发表于 2013-6-7 17:14
高飞版主的没有测试，LZ的程序获取的型心和用Region获取的有出入，不知是误差所致还是计算方法问题

代码是按照数学方法求的，等验证下，大家也可以帮测试下。

ScmTools

以前很多人都是借鉴质心函数讨论，数学计算的方法另有一凡意义

q3_2006

发布函数是不是也给个范例，新手的理解能力很差，完全不会用呀！

Lisphk

q3_2006 发表于 2013-6-16 18:01
发布函数是不是也给个范例，新手的理解能力很差，完全不会用呀！

告诉你了函数名，也告诉你了参数是 点表 ，还理解不了啊？

q3_2006

我还没入门，当然看不懂。意思是说能求随意几个点构成多边形的形心吗？的确没理解呀，i不如楼上的来段范例!

q3_2006

Lisphk 发表于 2013-6-16 19:13
告诉你了函数名，也告诉你了参数是 点表 ，还理解不了啊？

的确没理解呀，i不如楼上的来段范例!

Lisphk

q3_2006 发表于 2013-6-16 19:48
的确没理解呀，i不如楼上的来段范例!

你这个还真不好教，自己多看看论坛帖子吧。

q3_2006

Lisphk 发表于 2013-6-16 20:17
你这个还真不好教，自己多看看论坛帖子吧。

我的表达有问题，这个函数怎么用已经明白了，问题在之前“顶点组成的多边形不允许自交 ”，也就是我获取的点表是有顺序的，我不知道如何给点表排序，还请指教一下，谢谢了！

czcxxx_01

{:soso_e160:}{:soso_e161:}{:soso_e156:}