【越飞越高讲堂3】点、线、面、三角形和多边形

Highflybird

点、线、面、三角形和多边形

这里我整理和编写了一些关于几何算法上的一些LISP程序。
一些程序出于研究的目的，有可能代码不是最简洁的，但是执行效率高。
虽然经过了很多次测试，但未能保证完全正确。所以有什么错误或者bug请大家多多指教。
并贴上附件包含本主题所有源代码，和一些测试代码。  

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Line&Triangle.LSP 
下载次数:175  文件大小:57.27 KB 
下载权限: 不限 以上  [免费赚D豆]

申明：如需转载，请注明作者和来源地址！
另：如果有些函数不能在附件或者此贴中找到，请移步：
http://bbs.xdcad.net/thread-667494-1-1.html

一、点
1.  比例缩放点
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 比例缩放点                                    ;
;;;输入: 要缩放的点pt,基点pBase，缩放因子k             ;
;;;输出: 缩放后的点位置                                ;
;;;----------------------------------------------------;
(defun GEO:Scale (Pt pBase k)
  (mapcar (function (lambda (u v) (+ u (* k (- v u))))) pBase Pt)
)

;;;----------------------------------------------------;
;;;功能: 比例缩放点2倍                                 ;
;;;输入: 要缩放的点pt,基点pBase                        ;
;;;输出: 缩放后的点位置                                ;
;;;----------------------------------------------------;
(defun GEO:Scale2 (Pt pBase)
  (mapcar (function (lambda (u v) (+ v (- v u)))) pBase Pt)
)
[/pcode]
2、定比点
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 两点之中点                                    ;
;;;输入: 两点p1,P2                                     ;
;;;输出: 中点位置                                      ;
;;;----------------------------------------------------;
(defun GEO:Midpoint (p1 p2)
  (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
)

;;;----------------------------------------------------;
;;;功能: 定比点P,使得P1P / PP2 = k （此函数于三维）    ;
;;;输入: 两点p1,P2和比例系数k                          ;
;;;输出: 定比点位置                                    ;
;;;----------------------------------------------------;
(defun GEO:Proportion (p1 p2 k)
  (if (/= k -1)
    (mapcar (function (lambda (x1 x2) (/ (+ x1 (* k x2)) (+ 1.0 k)))) p1 p2)
  )
)
[/pcode]
3、点的旋转和镜像
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 两点法旋转某个点90度                          ;
;;;输入: 基点，矢量的第一点P1，第二点P1                ;
;;;输出: 旋转90度后点位置                              ;
;;;----------------------------------------------------;
(defun GEO:Rot90 (ptBase P1 P2)
  (mapcar '+ ptBase (MAT:Rot90 (mapcar '- p2 p1)))
)

;;;----------------------------------------------------;
;;;功能: 以基点旋转一点到指定的角度                    ;
;;;输入: 要旋转的点Pt，基点和旋转角度                  ;
;;;输出: 旋转后点位置                                  ;
;;;----------------------------------------------------;
(defun GEO:Rot2D (Pt PtBase Ang)  
  (mapcar '+ PtBase (MAT:Rot2D (mapcar '- Pt PtBase) Ang))
)

;;;----------------------------------------------------;
;;;功能: 以基点和角度镜像某点                          ;
;;;输入: 要镜像的点Pt，基点和镜像轴角度                ;
;;;输出: 镜像点位置                                    ;
;;;说明: 只适用与二维情况下，但速度最快                ;
;;;----------------------------------------------------;
(defun GEO:Mirror2D (Pt pBase Ang)
  (polar pBase (+ ang (- ang (angle pbase pt))) (distance pt pBase))
)

;;;----------------------------------------------------;
;;;功能: 镜像点（可以用于3D情况）                      ;
;;;输入: 要镜像的点Pt，镜像轴第一点和第二点            ;
;;;输出: 镜像点位置                                    ;
;;;说明: 可以适用于三维情况                            ;
;;;----------------------------------------------------;
(defun GEO:Mirror3D (Pt P1 P2 / v1 v2 dd P3 P4)
  (if (equal P1 P2 1e-8)
    (GEO:Scale2 P1 Pt)
    (setq v1 (mapcar '- Pt P1)
          v2 (mapcar '- P2 P1)
          dd (MAT:Dot v2 v2)
          P3 (GEO:Scale P2 P1 (/ (MAT:Dot v1 v2) dd))
          P4 (GEO:Scale2 P3 Pt)
    )   
  )
)

;;;----------------------------------------------------;
;;;功能: 镜像点（另一方法，相当于用 Mirror命令的结果） ;
;;;输入: 要镜像的点Pt，镜像轴第一点和第二点            ;
;;;输出: 镜像点位置                                    ;
;;;----------------------------------------------------;
(defun GEO:Mirror2D-1 (Pt P1 P2 / v p)
  (setq v (mapcar '- p2 p1))
  (setq p (trans (mapcar '- Pt P1) 0 v))
  (setq p (list (- (car p)) (cadr p) (caddr p)))
  (mapcar '+ P1 (trans p v 0))
)
[/pcode]
4、点集的质心
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 计算有限点集的质心                            ;
;;;输入: 有限个点集  Pts                               ;
;;;输出: 质心坐标，用点表表示                          ;
;;;----------------------------------------------------;
(defun GEO:Centroid (Pts / )
  (MAT:vxs (apply 'mapcar (cons '+ pts)) (/ 1.0 (length pts)))
)
[/pcode]
5、有关点集的其他几何算法：
   a.点集的凸包
     http://bbs.mjtd.com/forum.php?mod=viewthread&tid=56069
   b.点集的最小包围圆
     http://bbs.mjtd.com/forum.php?mod=viewthread&tid=55997
   c.点集的最小包围盒和直径
     http://bbs.mjtd.com/forum.php?mod=viewthread&tid=81308
   d.点集的最小距离点对
     http://bbs.mjtd.com/forum.php?mod=viewthread&tid=56310
   e.点集的三角网构建
     http://bbs.mjtd.com/thread-82644-2-1.html
   f.容差范围内的点集
     http://www.theswamp.org/index.php?topic=32874.60

二、线
1、直线方程
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;直线的方程                                          ;
;;;Coefficient Equation                                ;
;;;参数: 两点                                          ;
;;;返回: 直线的方程Ax+By+C=0 的三个系数A,B,C           ;
;;;----------------------------------------------------;
(defun LINE:Equation (p1 p2)
  (list
    (- (cadr p1) (cadr p2))
    (- (car  p2) (car  p1))
    (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2)))
  )
)

;;;----------------------------------------------------;
;;;直线的方程1                                         ;
;;;点矢量式方程  P0+k*Vector                           ;
;;;参数: 两点                                          ;
;;;返回: 直线的方程用一点和直线的方向矢量表达          ;
;;;----------------------------------------------------;
(defun LINE:Equation_1 (p0 p1)        
  (list P0 (mapcar '- p1 p0))
)
[/pcode]
2、直线偏移
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 偏移一条线段                                  ;
;;;输入: 两点和一个距离（负数代表直线段的下方）        ;
;;;输出: 偏移后的两点                                  ;
;;;----------------------------------------------------;
(defun LINE:Offset (p1 p2 d / v L)
  (setq v (mapcar '- p2 p1))
  (setq L (distance p1 p2))
  (setq v (Mat:vxs (Mat:Rot90 v) (/ d L)))
  (list (mapcar '+ p1 v) (mapcar '+ p2 v))
)
[/pcode]
3、点到直线的距离和垂足
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 点Pt到直线P1P2的距离（带方向）                ;
;;;输入: 要求的点Pt，和直线的两个端点P1,P2             ;
;;;输出: 带符号的距离，为正P1,P2,Pt逆时针，否则顺时针  ;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Distance (pt p1 p2 / A B C)
  (setq A (- (cadr p1) (cadr p2)))
  (setq B (- (car  p2) (car  p1)))
  (setq C (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2))))
  (if (not (and (= A 0) (= b 0)))
    (/ (+ (* A (car pt)) (* B (cadr pt)) C)
       (sqrt (+ (* A A) (* B B)))
    )
  )
)

;;;----------------------------------------------------;
;;;功能: 已知直线方程系数求点到直线的距离（带方向）    ;
;;;输入: 要求的点Pt，和直线方程的三个系数              ;
;;;输出: 带符号的距离，为正Pt在直线方向的上方，负则反之;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Distance_1 (Pt A B C / AA BB AB k x0 y0 x y D)
  (if (not (and (= a 0) (= b 0)))
    (progn
      (setq AA (* A A))
      (setq BB (* B B))
      (setq AB (* A B))
      (setq k  (+ AA BB))
      (setq x0 (car pt))
      (setq y0 (cadr pt))

      (setq x  (/ (- (* BB x0) (* AB y0) (* A C)) k))
      (setq y  (/ (- (* AA y0) (* AB x0) (* B C)) k))
      (setq D  (/ (+ (* A x0) (* B y0) C) (sqrt k)))
      (list D (list x y))
    )
  )
)

;;;----------------------------------------------------;
;;;功能: 点到直线的距离（带方向）                      ;
;;;输入: 要求的点Pt，和直线的两个端点P1,P2             ;
;;;输出: 带符号的距离，为正P1,P2,Pt逆时针，否则顺时针  ;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Distance_2 (pt p1 p2 / )
  (car (trans (mapcar '- pt p1) 0 (mapcar '- p2 p1)))
)

;;;----------------------------------------------------;
;;;功能: 点到直线的距离（适合三维情况）                ;
;;;输入: 要求的点Pt，和直线的两个端点P1,P2             ;
;;;输出: 所求距离                                      ;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Distance_3 (p0 p1 p2 / v0 v1)
  (setq v0 (mapcar '- P0 p1))
  (setq v1 (mapcar '- p2 p1))
  (/ (MAT:Norm3D (MAT:vxv v0 v1)) (MAT:Norm3D v1))
)

;;;----------------------------------------------------;
;;;功能: 点到直线的距离和垂足                          ;
;;;输入: 要求的点Pt，和直线的两个端点P1,P2             ;
;;;输出: 所求距离和垂足                                ;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Foot (pt p1 p2 / d)
  (setq d (LINE:Perpendicular_Distance pt p1 p2))
  (list d (polar pt (- (angle p1 p2) (/ pi 2)) d))
)

;;;----------------------------------------------------;
;;;功能: 点到直线的垂足                                ;
;;;输入: 要求的点Pt，和直线的两个端点P1,P2             ;
;;;输出: 所求的垂足                                    ;
;;;----------------------------------------------------;
(defun LINE:Perpendicular_Foot_1 (pt p1 p2)
  (inters pt (mapcar '+ pt (MAT:Rot90 (mapcar '- p1 p2))) p1 p2 nil)
)
[/pcode]
4.空间两直线的距离
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 求空间两直线的最短距离                        ;
;;;输入: 两条直线的四个端点P1,P2,P3,P4                 ;
;;;输出: 所求距离                                      ;
;;;----------------------------------------------------;
(defun LINE:Distance_LineToLine (P1 P2 P3 P4 / v1 v2 v3)
  (setq v1 (mapcar '- p2 p1))
  (setq v2 (mapcar '- p4 p3))
  (setq v3 (MAT:vxv v1 v2))
  (/ (Mat:Dot (mapcar '- P1 P3) v3) (Mat:Norm3D v3))
)
[/pcode]
5.我的直线求交
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 两条直线求交点函数(跟inters函数稍微有区别)    ;
;;;输入: 两条直线的四个端点P1,P2,P3,P4                 ;
;;;输出: nil 说明这两条平行或者共线，否则返回交点      ;
;;;----------------------------------------------------;
(defun LINE:Intersection (p1 p2 p3 p4 / DA DB DD X1 X2 X3 X4 Y1 Y2 Y3 Y4)
  (setq x1 (car  p1)
        x2 (car  p2)
        x3 (car  p3)
        x4 (car  p4)
        y1 (cadr p1)
        y2 (cadr p2)
        y3 (cadr p3)
        y4 (cadr p4)
  )
  (setq dd (- (* (- x1 x2) (- y3 y4)) (* (- x3 x4) (- y1 y2))))
  (setq da (- (* x1 y2) (* y1 x2)))
  (setq db (- (* x3 y4) (* y3 x4)))
  (if (not (equal dd 0 1e-8))
    (list (/ (- (* da (- x3 x4)) (* db (- x1 x2))) dd)
          (/ (- (* da (- y3 y4)) (* db (- y1 y2))) dd)
    )
  )
)
[/pcode]
6.有关直线的一些判断
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 判断平面上的三点是否共线                      ;
;;;输入: 三点 P1,P2,P3                                 ;
;;;输出: T 说明三点共线，否则不共线                    ;
;;;----------------------------------------------------;
(defun LINE:Colinearity (p1 p2 p3 / a b c eps)
  (setq eps 1e-6)
  (setq a (distance p2 p3))
  (setq b (distance p3 p1))
  (setq c (distance p1 p2))
  (or (equal (+ a b) c eps)
      (equal (+ b c) a eps)
      (equal (+ c a) b eps)
  )
)

;;;----------------------------------------------------;
;;;功能: 判断空间上三点是否共线(跟上面的方法效率差不多);
;;;输入: 三点 P1,P2,P3                                 ;
;;;输出: T 说明三点共线，否则不共线                    ;
;;;----------------------------------------------------;
(defun LINE:Colinearity3D (p1 p2 p3 / a1 a2)
  (equal (TRI:Det3P p1 p2 p3) 0 1e-8)
)

;;;----------------------------------------------------;
;;;功能: 判断两点是否在一条直线的同一侧                ;
;;;输入: 要判断的两点点P1,P2和直线的两个端点Pa,Pb      ;
;;;输出: T 说明同侧，nil异侧                           ;
;;;----------------------------------------------------;
(defun LINE:IsSameSide (P1 P2 Pa Pb / d1 d2 eps)
  (setq eps 1e-6)
  (setq d1 (TRI:Det3P P1 PA PB))
  (setq d2 (TRI:Det3P P2 PA PB))
  (or (and (<= d1 eps) (<= d2 eps))
      (and (>= d1 (- eps)) (>= d2 (- eps)))
  )
)
[/pcode]
三、面和空间
1.平面方程
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 点法线的平面方程                              ;
;;;输入: P0平面上的一点，N平面的法线矢量               ;
;;;输出: 平面方程的系数列表                            ;
;;;----------------------------------------------------;
(defun PLANE:Equation (P0 N)
  (append N (list (- (MAT:Dot P0 N))))
)

;;;----------------------------------------------------;
;;;功能: 三点式平面方程                                ;
;;;输入: 平面上的三点                                  ;
;;;输出: 平面方程的系数列表                            ;
;;;----------------------------------------------------;
(defun PLANE:Equation_3P (P0 P1 P2 / v1 v2 N)
  (setq v1 (mapcar '- p1 p0))
  (setq v2 (mapcar '- P2 p0))
  (setq N  (MAT:vxv v1 v2))
  (PLANE:Equation P0 N)
)
[/pcode]
2.点到平面的距离
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 点到平面的距离（有向的距离）                  ;
;;;输入: 一点P和平面的方程为Ax+By+Cz+D=0的四个系数     ;
;;;输出: 该点到平面的距离                              ;
;;;----------------------------------------------------;
(defun PLANE:Distance (P A B C D)
  (if (and (zerop A) (zerop B) (zerop C))
    nil
    (/ (+ (* A (car P)) (* B (cadr P)) (* C (caddr P)) D)
       (distance '(0 0 0) (list A B C))
    )
  )
)

;;;----------------------------------------------------;
;;;功能: 点到三点决定的平面的距离（有向的距离）        ;
;;;输入: 一点P和平面的方程为Ax+By+Cz+D=0的四个系数     ;
;;;输出: 该点到平面的距离                              ;
;;;----------------------------------------------------;
(defun PLANE:Distance_1 (P p1 p2 p3 /)
  (Apply 'PLANE:Distance (cons p (PLANE:Equation_3P p1 p2 p3)))
)

;;;----------------------------------------------------;
;;;功能: 点到三点决定的平面的距离和该点在平面上的投影点;
;;;输入: 一点P和三点P1,P2,P3决定的平面                 ;
;;;输出: 该点到平面的距离                              ;
;;;----------------------------------------------------;
(defun PLANE:Perpendicular_Foot (P p1 p2 p3 / F A B C D H N L)
  (setq F (PLANE:Equation_3P p1 p2 p3))
  (setq        A (car f)
        B (cadr f)
        C (caddr f)
        D (last f)
  )
  (setq H (PLANE:Distance p A B C D))
  (setq N (List A B C))
  (setq L (distance '(0 0 0) N))
  (if (not (zerop L))
    (list H (Geo:scale (mapcar '+ p N) P (- (/ H L))))
  )
)
[/pcode]
3.空间直线与平面的交点
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 求空间直线与平面的交点                        ;
;;;输入: 决定直线的两点Pa,Pb和三点P1,P2,P3决定的平面   ;
;;;输出: 该点到平面的距离                              ;
;;;----------------------------------------------------;
(defun PLANE:Line_Inters_Plane (Pa Pb A B C D / h1 h2)
  (setq h1 (Plane:Distance Pa A b c d))
  (setq h2 (plane:distance Pb a b c d))
  (if (and h1 h2)
    (cond
      ( (equal h1 0 1e-14) Pa)
      ( (equal h2 0 1e-14) Pb)
      (t (GEO:Proportion Pa Pb (- (/ h1 h2))))
    )
  )
)
[/pcode]
四、三角形
1.根据边长判断是否构成三角形
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 判断是否构成三角形                            ;
;;;输入: 三边的长度a,b,c                               ;
;;;输出: 构成三角形则返回T，否则返回nil                ;
;;;----------------------------------------------------;
(defun TRI:IsTriangle (a b c /)
  (and (> (+ a b) c) (> (+ b c) a) (> (+ c a) b))
)
[/pcode]
2.三角形的外心，内心，重心，垂心，九点圆圆心
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 求三角形外心   TRI:CircumCenter，ExCenter     ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这三点的外接圆的圆心和半径                    ;
;;;说明: 尽管这样写很麻烦，显得代码很多，但运行却很快  ;
;;;----------------------------------------------------;
(defun TRI:CircumCenter (P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
  (setq        X0  (car  P0)
        Y0  (cadr P0)
        X1  (car  P1)
        Y1  (cadr P1)
        X2  (car  P2)
        Y2  (cadr P2)
        DX1 (- X1 X0)
        DY1 (- Y1 Y0)
        DX2 (- X2 X0)
        DY2 (- Y2 Y0)
  )
  (setq D (- (* DX1 DY2) (* DX2 DY1)))
  (if (equal D 0 1e-14)
    nil
    (progn
      (setq 2D (+ D D)
            C1 (+ (* DX1 (+ X0 X1)) (* DY1 (+ Y0 Y1)))
            C2 (+ (* DX2 (+ X0 X2)) (* DY2 (+ Y0 Y2)))
            CE (List (/ (- (* C1 DY2) (* C2 DY1)) 2D)
                     (/ (- (* C2 DX1) (* C1 DX2)) 2D)
               )
      )
      (list CE (distance CE P0))
    )
  )
)

;;;----------------------------------------------------;
;;;功能: 三角形内心                                    ;
;;;公式: (aX1+bx2+cx3)/(a+b+c),(aY2+bY2+CY3)/(a+b+c)   ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这三点的内切圆的圆心和半径                    ;
;;;----------------------------------------------------;
(defun TRI:InCenter (pa pb pc / a b c L I r)
  (setq a (distance pb pc))
  (setq b (distance pc pa))
  (setq c (distance pa pb))
  (setq L (+ a b c))
  (if (/= L 0.0)
    (setq I (MAT:SxVs (list pa pb pc) (list (/ a L) (/ b L) (/ c L)))
          R (list I (abs (LINE:Perpendicular_Distance I pa pb)))
    )
    (list pa 0)
  )
)

;;;----------------------------------------------------;
;;;功能: 三角形垂心                                    ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这个三点形成的三角形的垂心                    ;
;;;----------------------------------------------------;
(defun TRI:OrthoCenter (pa pb pc / p1 p2)
  (setq p1 (GEO:Rot90 Pa pb pc))
  (setq p2 (GEO:Rot90 pb pc pa))
  (inters pa p1 pb p2 nil)
)

;;;----------------------------------------------------;
;;;功能: 三角形重心                                    ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这个三点形成的三角形的重心                    ;
;;;----------------------------------------------------;
(defun TRI:Barycenter (p1 p2 p3)
  (mapcar (function (lambda (e1 e2 e3) (/ (+ e1 e2 e3) 3.0))) p1 p2 p3)
)

;;;----------------------------------------------------;
;;;功能: 三角形的九点圆                                ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这个三点形成的三角形的九点圆的圆心和半径      ;
;;;----------------------------------------------------;
(defun TRI:9P_Circle (pa pb pc)
  (apply 'TRI:CircumCenter
         (mapcar 'GEO:Midpoint  (list pa pb pc) (list pb pc pa))
  )
)
[/pcode]
3.三角形的三线坐标和其他心及其点（相似重心，等周点，等角共轭点等）
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;三线坐标转化为世界坐标      k = 2S/(ax+by+cz)       ;
;;;注意: 三线坐标跟笛卡尔坐标的表示上的不同            ;
;;;输入: 三线坐标P(list x y z)=>x:y:z和对应三点Pa,Pb,Pc;
;;;输出: 返回世界坐标系的点                            ;
;;;----------------------------------------------------;
(defun TRI:TCS->WCS (P Pa Pb Pc / x y z V1 V2 V3 p1 p2 p3 int)
  (setq V1 (LINE:Offset Pb Pc (car P)))
  (setq V2 (LINE:Offset Pc Pa (cadr p)))
  (setq V3 (LINE:Offset Pa Pb (caddr p)))
  (setq p1 (inters (car V2) (cadr V2) (car V3) (cadr V3) nil))
  (setq p2 (inters (car V3) (cadr V3) (car V1) (cadr V1) nil))
  (setq p3 (inters (car V1) (cadr V1) (car V2) (cadr V2) nil))
  (if (setq int (inters Pa P1 Pb P2 nil))
    int
    (if (setq int (inters Pb P2 Pc P3 nil))
      int
      (inters Pc P3 Pa P1 nil)
    )
  )
)

;;;----------------------------------------------------;
;;;功能: 相似重心,Lemoine Point ,or symmedian point    ;
;;;输入: 给定不共线的三个点                            ;
;;;输出: 这个三点形成的三角形的相似重心                ;
;;;----------------------------------------------------;
(defun TRI:Symmedian_Point (Pa Pb Pc / a b c)
  (setq a (distance Pb Pc))
  (setq b (distance pc Pa))
  (setq c (distance Pa Pb))
  (TRI:TCS->WCS (list a b c) Pa Pb Pc)
)

;;;----------------------------------------------------;
;;;功能: 某点对给定三角形的等角共轭点                  ;
;;;输入: 一点Pt 和构成三角形的三点Pa Pb Pc             ;
;;;输出: 这点对给定三角形的等角共轭点                  ;
;;;----------------------------------------------------;
(defun TRI:Isogonal-Conjugate-Point (Pt Pa Pb Pc / Pt1 Pt2 Inc)
  (setq InC (car (TRI:InCenter Pa Pb Pc)))
  (setq Pt1 (GEO:Mirror3D Pt Pa Inc))
  (setq pt2 (GEO:Mirror3D Pt Pb Inc))
  (inters Pa Pt1 Pb Pt2 nil)
)

;;;----------------------------------------------------;
;;;功能: 某点对给定三角形的等角共轭点                  ;
;;;输入: 一点Pt 和构成三角形的三点Pa Pb Pc             ;
;;;输出: 这点对给定三角形的等角共轭点                  ;
;;;说明: 如果已知三角形内心，则可以简略计算            ;
;;;----------------------------------------------------;
(defun TRI:Isogonal-Conjugate-Point-1 (Pt Pa Pb Inc /)
  (inters Pa (GEO:Mirror3D Pt Pa Inc) Pb (GEO:Mirror3D Pt Pb Inc) nil)
)

;;;----------------------------------------------------;
;;;根据三角形的三边长获取三角形信息                    ;
;;;输入: 三边的边长a,b,c                               ;
;;;输出: 三角形的三个角度，面积和周长，内心和内切圆半径;
;;;      旁切圆的圆心和半径，外心和外接圆半径，垂心，  ;
;;;      重心，类似重心，等周心以及九点圆圆心          ;
;;;----------------------------------------------------;
;|
http://en.wikipedia.org/wiki/Trilinear_coordinates      
where a, b, c are the respective sidelengths BC, CA, AB,
and σ = area of ABC.                                   
A = 1 : 0 : 0                                          
B = 0 : 1 : 0                                          
C = 0 : 0 : 1                                          
incenter = 1 : 1 : 1                                    
centroid = bc:ca:ab = 1/a:1/b:1/c = cscA : cscB : cscC.
circumcenter = cos A : cos B : cos C.                  
orthocenter = sec A : sec B : sec C.                    
nine-point center = cos(B - C) : cos(C - A) : cos(A - B)
symmedian point = a : b : c = sin A : sin B : sin C.   
A-excenter = -1 : 1 : 1                                 
B-excenter = 1 : -1 : 1                                 
C-excenter = 1 : 1 : -1.                                
;;;de Longchamps point                                 
;;;http://en.wikipedia.org/wiki/De_Longchamps_point     
;;;symmedian point                                      
;;;http://en.wikipedia.org/wiki/Symmedian_point         
http://mathworld.wolfram.com/TriangleCenter.html        
|;
(defun TRI:InfoBy3Sides (a b c / p S 2S Aa Ab Ac D K Ri Re Ra Rb Rc Ca Cb Cc Sa Sb Sc)
  (setq p  (* 0.5 (+ a b c)))                           ;半周长
  (setq S  (sqrt (* p (- p a) (- p b) (- p c))))        ;面积
  (setq Ri (/ S p))                                     ;内切圆半径
  (setq K  (* 2 Ri p))
  (setq Ra (/ k (+ b c (- a))))                         ;边A旁切圆半径
  (setq Rb (/ k (+ c a (- b))))                         ;边B旁切圆半径
  (setq Rc (/ k (+ a b (- c))))                         ;边C旁切圆半径
  (setq Re (/ (* a b c 0.25) S))                        ;外接圆半径
  (setq D  (+ Re Re))                                   ;外接圆直径
  (setq Ca (/ (+ (* b b) (* (+ c a) (- c a))) 2 b c))   ;角A余弦
  (setq Cb (/ (+ (* c c) (* (+ a b) (- a b))) 2 c a))   ;角B余弦
  (setq Cc (/ (+ (* a a) (* (+ b c) (- b c))) 2 a b))   ;角C余弦
  (setq Sa (/ a D))                                     ;角A正弦
  (setq Sb (/ b D))                                     ;角B正弦
  (setq Sc (/ c D))                                     ;角C正弦
  (setq Aa (atan Sa Ca))                                ;角A
  (setq Ab (atan Sb Cb))                                ;角B
  (Setq Ac (atan Sc Cc))                                ;角C
  (setq 2S (+ S S))
  (list (list Aa Ab Ac)                                 ;三个角
        (list S (+ p p))                                ;面积和周长
        (list '( 1  1  1) Ri)                           ;内心
        (list '(-1  1  1) Ra)                           ;边A旁切圆半径
        (list '( 1 -1  1) Rb)                           ;边B旁切圆半径
        (list '( 1  1 -1) Rc)                           ;边C旁切圆半径
        (list (list Ca Cb Cc) Re)                       ;外心
        (list (list (/ 1 Ca) (/ 1 Cb) (/ 1 Cc)))        ;垂心
        (list (list (/ 1 a) (/ 1 b) (/ 1 c)))           ;重心
        (list (list a b c))                             ;类似重心
        (list (list (cos (- Ab Ac))
                    (cos (- Ac Aa))
                    (cos (- Aa Ab))
              )                                         ;九点圆圆心
              (* 0.5 Re)                                ;九点圆半径
        )
        (list (list (1- (/ 2S a (+ b c (- a))))      
                    (1- (/ 2S b (+ c a (- b))))
                    (1- (/ 2S c (+ a b (- c))))
              )
        )                                               ;等周点(Isoperimetric Point)
  )
)
[/pcode]
4.三角形的面积
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 定义三点的行列式,即三点之倍面积               ;
;;;输入: 三点P1,P2,P3                                  ;
;;;输出: 这三点形成的三角形的面积的2倍，符号指示方向。 ;
;;;----------------------------------------------------;
(defun TRI:Det3P (p1 p2 p3)
  (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
     (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
  )
)

;;;----------------------------------------------------;
;;;功能: 用海伦公式(Heron's formula)求三角形面积       ;
;;;输入: 三角形的三个边长a,b,c                         ;
;;;输出: 三角形面积                                    ;
;;;----------------------------------------------------;
(defun TRI:Area (a b c / p)
  (setq p (* 0.5 (+ a b c)))
  (sqrt (* p (- p a) (- p b) (- p c)))
)

;;;----------------------------------------------------;
;;;功能: 计算已知空间三点的三角形面积                  ;
;;;输入: 空间三点 P1,P2,P3                             ;
;;;输出: 三角形面积                                    ;
;;;----------------------------------------------------;
(defun TRI:Area3D (p1 p2 p3 / v1 v2 d1 d2 d3)
  (setq v1 (mapcar '- p2 p1))
  (setq v2 (mapcar '- p3 p1))
  (setq d1 (MAT:Det2 (car   v1) (cadr  v1) (car   v2) (cadr  v2)))
  (setq d2 (MAT:Det2 (cadr  v1) (caddr v1) (cadr  v2) (caddr v2)))
  (setq d3 (MAT:Det2 (caddr v1) (car   v1) (caddr v2) (car   v2)))
  (* 0.5 (sqrt (+ (* d1 d1) (* d2 d2) (* d3 d3))))
)
[/pcode]
五、多边形
1.多边形的面积和周长
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 计算多边形面积(为简单多边形，不自交的多边形)  ;
;;;输入: 多边形顶点列表  Pts                           ;
;;;输出: 一个数值，如果为正则是CCW(逆时针)，否则顺时针 ;
;;;参考: Centroid  Shoelace formula                    ;
;;;----------------------------------------------------;
(defun POLY:Area (pts)
  (* (apply '+ (mapcar 'MAT:Det2V pts (MISC:1st->Last Pts))) 0.5)
)
;;;----------------------------------------------------;
;;;功能: 计算多边形周长                                ;
;;;输入: 多边形顶点列表  Pts                           ;
;;;输出: 一个数值，表示多边形周长                      ;
;;;----------------------------------------------------;
(defun POLY:Perimeter (pts)
  (apply '+ (mapcar 'distance pts (MISC:1st->Last Pts)))
)
[/pcode]
2.多边形的方向
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;功能: 判断多边形的方向(为简单多边形，不自交的多边形);
;;;输入: 多边形顶点列表  Pts                           ;
;;;输出: 返回T则是CCW(逆时针)，否则顺时针              ;
;;;----------------------------------------------------;
(defun POLY:IsCCW (Pts)
  (> (POLY:Area pts) 0.0)
)
[/pcode]
3.获取含有弧段的多边形的信息（面积，周长，质心）  
此方法纯为lisp计算，并非通过region建模获得，因而更快速，适合重复运算。
[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
)

;;;----------------------------------------------------;
;;;Circular segment                                    ;
;;;弓的质心求以及弓形的面积                            ;
;;;输入: C---圆心;Center                               ;
;;;      R---半径;Radius                               ;
;;;      A1--起始角;0 <= A1 <= 2*Pi Start Angle(Radian);
;;;      A2--终止角;0 <= A2 <= 2*Pi End Angle(Radian)  ;
;;;      IsCW--是否顺时针                              ;
;;;输出: 列表: 第一项为质心，第二项为面积，第三项为弧长;
;;;----------------------------------------------------;
(defun CIR:Circular_Segment (C R A1 A2 IsCW / A k d S e)
  (and isCW (setq A A2 A2 A1 A1 A))
  (if (> A1 A2)
    (setq A (- (+ pi pi A2) A1 ))
    (setq A (- A2 A1))
  )
  (setq k (sin (* 0.5 A)))
  (setq k (* 1.333333333333333333333 R k k k))
  (setq e (- A (sin A)))
  (setq S (* 0.5 R R e))
  (and IsCW (setq S (- S)))                             ;如果顺时针，面积为负
  (setq d (/ k e))
  (if (> A1 A2) (setq d (- d)))                         ;这种情况下要反向
  (list (polar C (* 0.5 (+ A1 A2)) d) S (* A R))
)

;;;----------------------------------------------------;
;;;Circular sector                                     ;
;;;扇形的质心，面积和周长                              ;
;;;输入: C---圆心;Center                               ;
;;;      R---半径;Radius                               ;
;;;      A1--起始角;0 <= A1 <= 2*Pi Start Angle(Radian);
;;;      A2--终止角;0 <= A2 <= 2*Pi End Angle(Radian)  ;
;;;      IsCW--是否顺时针                              ;
;;;输出: 列表: 第一项为质心，第二项为面积，第三项为周长;
;;;----------------------------------------------------;
(defun CIR:Circular_Sector (C R A1 A2 IsCW / A d S L)
  (and IsCW (setq A A2 A2 A1 A1 A))
  (if (> A1 A2)
    (setq A (- (+ pi pi A2) A1))
    (setq A (- A2 A1))
  )
  (setq d (/ (* 4 R (sin (* 0.5 A))) 3 A))
  (setq S (* 0.5 A R R))                                
  (and IsCW (setq S (- S)))                             ;如果顺时针，面积为负
  (setq L (* R (+ A 2)))                                ;周长
  (if (> A1 A2) (setq d (- d)))                         ;这种情况下要反向
  (list (polar C (* 0.5 (+ A1 A2)) d) S L)
)

;;;----------------------------------------------------;
;;;获得轻多段线的有弧段处的顶点的信息                  ;
;;;输入: P1---顶点坐标(OCS)                            ;
;;;      P2---下一顶点坐标(OCS)                        ;
;;;      b----凸度（不为零）                           ;
;;;输出: 列表: 第一项为质心，第二项为面积，第三项为弧长;
;;;----------------------------------------------------;
(defun POLY:Info_Bulge (P1 P2 b / D A k C R)
  (setq D (distance p1 p2))
  (setq A (angle p1 p2))
  (setq k (* d (1+ (* b b)) 0.25))
  (setq C (polar p1 (+ a (- (* pi 0.5) (* 2 (atan b)))) (/ k b)))
  (setq R (/ k (abs b)))
  (CIR:Circular_Segment C R (angle c p1) (angle c p2) (< b 0))
)

;;;----------------------------------------------------;
;;;获得轻多段线的信息                                  ;
;;;输入: LWPoly---轻多段线的实体名                     ;
;;;输出: 列表: 第一项为质心，第二项为面积，第三项为弧长;
;;;----------------------------------------------------;
(defun POLY:Info_LWPoly (LWPoly / eps Object Points Number IsOpen I P P0 Q Ret b Cen1
                                  Area1 List1 List2 Part1 Leng1 Leng2 AreaLst CenLst)
  (setq eps 1e-6)
  (setq Object (vlax-ename->vla-object LWPoly))
  (setq Points (vlax-get Object 'Coordinates))
  (setq Number (/ (length Points) 2))
  (setq IsOpen (= (vla-get-closed Object) :vlax-false))
  (and IsOpen (setq Number (1+ Number)))
  (setq i 0)

  (setq p0  (list (car Points) (cadr Points)))
  (setq p p0)
  (repeat number
    (if (setq Points (cddr Points))
      (setq q (list (car Points) (cadr Points)))        ;下一顶点
      (setq q P0)                                       ;如果顶点是最后点，则取第一点
    )
    (if (not (equal p q eps))                           ;这步为的是消除重合的点。
      (progn
        (setq b (vla-getbulge Object i))                ;取得这点的凸度
        (if (or (/= b 0.0) (and (null points) IsOpen))  ;如果有凸度或者在末端
          (setq List1 (cons (list P b 0) List1))        ;则不计算这点长度
          (setq List1 (cons (list p b (distance p q)) List1))      
        )
        (if (and (/= b 0.0) (or Points (not IsOpen)))   ;如果有凸度(末端不封闭情况不计算)
          (setq List2 (cons (POLY:Info_Bulge p q b) List2))
        )
      )
    )
    (setq p q)
    (setq i (1+ i))
  )
  (setq list1 (reverse List1))
  (setq list2 (reverse list2))
  (setq part1 (POLY:Infomation (mapcar 'car list1)))    ;不含弧段的部分
  (setq Cen1  (car Part1))                              ;不含弧段部分的质心
  (setq Area1 (cadr Part1))                             ;不含弧段部分的面积
  (setq leng1 (apply '+ (mapcar 'last list1)))          ;不含弧段部分的总长
  (if List2                                             ;含弧段的部分
    (setq leng2   (apply '+ (mapcar 'last list2))       ;含弧段部分的总长
          CenLst  (cons Cen1 (mapcar 'car list2))       ;含弧段部分的质心
          AreaLst (cons Area1 (mapcar 'cadr list2))     ;含弧段部分的面积
          ret     (GEO:Centroid_Composition CenLst AreaLst)
          ret     (list (car ret) (cadr ret) (+ leng1 leng2))
    )
    (list Cen1 Area1 leng1)
  )
)
[/pcode]
六、附带的一些函数
详细参见附件。包括了实体的创建，程序的测试，和一些其他相关函数。
[pcode=lisp,true]
;;;----------------------------------------------------;
;;;创建一个点                                          ;
;;;输入: 一个三维或者二维的点                          ;
;;;输出: 点实体的图元名                                ;
;;;----------------------------------------------------;
(defun Ent:Make_Point (p)
  (entmakex (list '(0 . "POINT") (cons 10 p)))
)

;;;----------------------------------------------------;
;;;创建一个带颜色的点（此函数为测试或者其他用途）      ;
;;;输入: 一个三维或者二维的点表和一个颜色号            ;
;;;输出: 点实体的图元名                                ;
;;;----------------------------------------------------;
(defun Ent:MakePoint-1 (p c)
  (entmakex (list '(0 . "POINT") (cons 10 p) (cons 62 c)))
)

;;;----------------------------------------------------;
;;;创建一条直线段                                      ;
;;;输入: 两个三维或者二维的点                          ;
;;;输出: 线段实体的图元名                              ;
;;;----------------------------------------------------;
(defun Ent:Make_Line (p q)
  (entmakeX (list '(0 . "LINE") (cons 10 p) (cons 11 q)))
)

;;;----------------------------------------------------;
;;;创建一个由三条直线组成的三角形                      ;
;;;输入: 三个三维或者二维的点                          ;
;;;输出: 由三条直线组成的三角形                        ;
;;;----------------------------------------------------;
(defun Ent:Make_Triangle (p1 p2 p3)
  (mapcar 'Ent:Make_Line (list p1 p2 p3) (list p2 p3 p1))
)

;;;----------------------------------------------------;
;;;创建一个三维多段线                                  ;
;;;输入: 三维的点集                                    ;
;;;输出: 三维多段线实体                                ;
;;;----------------------------------------------------;
(defun Ent:Make_Poly (pts / e)
  (setq e (Entmake (list '(0 . "POLYLINE") '(70 . 9))))
  (foreach p pts
    (entmake (list '(0 . "VERTEX") '(70 . 32) (cons 10 p)))
  )
  (entmake '((0 . "SEQEND")))
  e
)

;;;----------------------------------------------------;
;;;创建轻多段线                                        ;
;;;输入: 二维的点集                                    ;
;;;输出: 轻多段线实体名                                ;
;;;----------------------------------------------------;
(defun Ent:Make_LWPoly (pts closed /)
  (entmakeX                                             
    (append
      '((0 . "LWPOLYLINE")
        (100 . "AcDbEntity")
        (100 . "AcDbPolyline")
       )
      (list (cons 90 (length pts)))                     ;顶点个数
      (mapcar (function (lambda (x) (cons 10 x))) pts)  ;多段线顶点
      (list (cons 70 (if closed 1 0)))                  ;闭合的
    )
  )
)
[/pcode]
七、测试部分
以下程序为测试用，包含了多个函数的测试。
[pcode=lisp,true]
;;;*****************************************************;
;;;以下为测试所用，大家可各取所需                       ;
;;;*****************************************************;

;;;测试坐标变换函数Mat:TransU2W和TransW2U
(defun C:TestTransU2W (/ x y s e d p q v)
  (initget 1)
  (setq x (getdist "\nX:"))
  (initget 1)
  (setq y (getdist "\nY:"))
  (initget 1)
  (setq s (ssget ":S" '((0 . "LINE"))))
  (if (and x y s)
    (progn
      (setq e (ssname s 0))
      (setq d (entget e))
      (setq p (cdr (assoc 10 d)))
      (setq q (cdr (assoc 11 d)))
      (setq v (MAT:TransU2W (list x y) p (mapcar '- q p)))
      (Ent:Make_Point V)
    )
  )
)

;;;测试旋转函数GEO:Rot2d
(defun c:TestRot2d ( / pt pb an)
  (initget 1)
  (setq pt (getpoint "\n要旋转的点:"))
  (initget 1)
  (setq pb (getpoint "\n基点:"))
  (initget 1)
  (setq an (getangle "\n角度:"))
  (ent:make_point pt)
  (ent:make_point pb)
  (ent:make_point (GEO:Rot2d Pt Pb an))
  (princ)
)

;;;测试镜像函数
(defun c:TestMirror (/ p1 p2 pt s)
  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (initget 1)
  (setq p2 (getpoint "\n2:"))
  (initget 1)
  (setq pt (getpoint "\n要镜像的点:"))
  (grdraw p1 p2 1)
  (setq s (MiSC:Test 10000
                     '((GEO:Mirror2D pt p1 (angle p1 p2))
                       (GEO:Mirror3D Pt p1 p2)
                       (GEO:Mirror2D-1 Pt p1 p2)
                      )
          )
  )
  (mapcar 'Ent:Make_Line (list pt pt pt) (mapcar 'last s))
  (princ)
)

;;;测试垂足和垂距函数
(defun C:LPF(/ p1 p2 pt f a b c s)
  (initget 1)
  (setq p1 (getpoint "\n直线端点1:"))
  (initget 1)
  (setq p2 (getpoint "\n直线端点2:"))
  (initget 1)
  (setq pt (getpoint "\n要求的点p:"))

  (setq f (LINE:Equation p1 p2))
  (setq A (car f))
  (setq B (cadr f))
  (setq C (caddr f))

  (setq S (MISC:Test 10000
                '((LINE:Perpendicular_Foot pt p1 p2)
                  (LINE:Perpendicular_Distance_1 pt A B C)
                  (LINE:Perpendicular_Distance_2 pt P1 p2)
                  (LINE:Perpendicular_Distance_3 Pt P1 P2)
                  (MAT:TransW2U pt P1 (mapcar '- p2 p1)))
          )
  )

  (grdraw p1 p2 1)
  (Ent:Make_Point pt)
  (Ent:MakePoint-1 (cadr (last (car  s))) 1)
  (Ent:MakePoint-1 (cadr (last (cadr s))) 2)
  (princ (mapcar 'last s))
  (princ)
)

;;;测试线段相交函数
(defun C:Inters (/ p1 p2 p3 p4 s)
  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (initget 1)
  (setq p2 (getpoint p1 "\n2:"))
  (initget 1)
  (setq p3 (getpoint "\n3:"))
  (initget 1)
  (setq p4 (getpoint p3 "\n4:"))

  (grdraw p1 p2 1)
  (grdraw p3 p4 2)
  (setq s (MISC:Test 100000
                     '((LINE:Intersection p1 p2 p3 p4)
                       (inters p1 p2 p3 p4 nil)
                      )
          )
  )
  (foreach p (mapcar 'last s)
    (Ent:make_Point p)
  )
)

;;;测试角平分线函数
(defun c:pf(/ e1 e2 d1 d2 p1 p2 p3 p4 ret)
  (setq e1 (car (entsel "\n直线1:")))
  (setq e2 (car (entsel "\n直线2:")))
  (setq d1 (entget e1))
  (setq d2 (entget e2))
  (setq p1 (cdr (assoc 10 d1)))
  (setq p2 (cdr (assoc 11 d1)))
  (setq p3 (cdr (assoc 10 d2)))
  (setq p4 (cdr (assoc 11 d2)))
  (setq ret (LINE:Angular_Bisector p1 p2 p3 p4))
  (foreach n ret
    (apply 'Ent:Make_line n)
  )
)

;;;测试偏移两点函数LINE:Offset
(defun C:LineOffset (/ p1 p2 d)
  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (initget 1)
  (setq p2 (getpoint p1 "\n2:"))
  (initget 1)
  (setq d (getdist p1 "\n偏移距离:"))
  (Ent:make_line p1 p2)
  (apply 'Ent:make_line (LINE:Offset p1 p2 d))
  (princ)
)

;;;测试共线检测函数LINE:Colinearity,LINE:Colinearity_1
(defun C:Colinearity (/ p1 p2 p3)
  (setq eps 1e-6)
  (setq p1 (getpoint "\n1:"))
  (setq p2 (getpoint "\n2:"))
  (setq p3 (getpoint "\n3:"))
  (MISC:Test 100000
             '((LINE:Colinearity p1 p2 p3)
               (LINE:Colinearity3D p1 p2 p3)
              )
  )
  (princ)
)

;;;平面部分测试函数
(defun c:PlaneTest(/ pa pb p1 p2 p3 d1 d2 arg)
  (initget 1)
  (setq pa (getpoint "\npa:"))
  (setq pa (trans pa 1 0))
  (initget 1)
  (setq pb (getpoint "\npb:"))
  (setq pb (trans pb 1 0))

  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (setq p1 (trans p1 1 0))
  (initget 1)
  (setq p2 (getpoint "\n2:"))
  (setq p2 (trans p2 1 0))
  (initget 1)

  (setq p3 (getpoint "\n3:"))
  (setq p3 (trans p3 1 0))

  (mapcar 'Ent:make_Point (list pa pb p1 p2 p3))

  (princ (PLANE:Distance_1 Pa p1 p2 p3))

  (setq d1 (PLANE:Perpendicular_Foot Pa p1 p2 p3))
  (setq d2 (PLANE:Perpendicular_Foot Pb p1 p2 p3))
  (setq arg (cons pa (cons Pb (PLANE:Equation_3P p1 p2 p3))))
  (setq ret (apply 'PLANE:Line_Inters_Plane arg))
  (Ent:make_Point (cadr d1))
  (Ent:make_Point (cadr d2))
  (Ent:make_Point ret)
  (princ (LINE:Distance_LineToLine pa pb p1 p2))
  (princ)
)

;;;三线坐标系统测试
(defun C:InfoBy3Sides (/ p1 p2 p3 a b c ret)
  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (initget 1)
  (setq p2 (getpoint "\n2:"))
  (initget 1)
  (setq p3 (getpoint "\n3:"))
  (setq p1 (trans p1 1 0))
  (setq p2 (trans p2 1 0))
  (setq p3 (trans p3 1 0))
  (setq a  (distance p2 p3))
  (setq b  (distance p3 p1))
  (setq c  (distance p1 p2))
  (Ent:make_Poly (list p1 p2 p3))
  (setq ret (TRI:InfoBy3Sides a b c))
  (princ ret)
  (foreach n (cddr ret)
    (setq p (TRI:TCS->WCS (car n) p1 p2 p3))
    (Ent:make_Point p)
    (if (setq r (cadr n))
      (Ent:make_Circle p r)
    )
  )
  (princ)
)

;;;Test for "POLY:Info_LWPoly" "Geo:Centroid" "POLY:Area" "POLY:Perimeter" "POLY:Infomation"
;;;为段线的质心和面积的测试
(defun C:CentroidTest (/ sel ent en1 dxf pts cen aaa len ret i)
  (setq i -1)
  (setq sel (ssget '((0 . "*POLYLINE"))))
  (if sel
    (repeat (sslength sel)
      (setq ent (ssname sel (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ent))
      (setq dxf (entget ent))
      (if (= (cdr (assoc 0 DXF)) "POLYLINE")
        (setq pts (MISC:List->PtList (vlax-get obj 'coordinates) 3)
              Cen (GEO:Centroid pts)
              aaa (POLY:Area pts)
              len (POLY:Perimeter pts)
              ret (POLY:Infomation pts)
              en1 (Ent:MakePoint-1 Cen 2)      
        )
        (setq ret (POLY:Info_LWPoly ent)
              aaa (vla-get-area obj)
        )
      )
      (setq cen (car ret))
      (setq len (vla-get-length obj))
      (Ent:MakePoint-1 cen 1)
      (princ (strcat "\n第" (itoa i) "个物体信息: "))
      (princ (list ret Cen aaa len))
      (princ)
    )
  )
)

;;;弧段的质心和面积的测试
(defun C:TestArcCentroid (/ A1 A2 C R E1 I O1 O2 O3 O4 P1 P2 S1 S2 SS V3 V4)
  (setq i -1)
  (if (setq ss (ssget '((0 . "ARC"))))
    (repeat (sslength ss)
      (setq e1 (ssname ss (setq i (1+ i))))
      (setq o1 (vlax-ename->vla-object e1))

      (setq C (vlax-get o1 'Center))
      (setq R (vla-get-radius o1))
      (setq A1 (vla-get-startangle o1))
      (setq A2 (vla-get-endangle o1))

      (setq V3 (CIR:Circular_Segment C R A1 A2 nil))    ;圆弧总是逆时针的
      (setq V4 (CIR:Circular_Sector C R A1 A2 nil))     ;圆弧总是逆时针的

      (setq p1 (vlax-curve-getstartpoint e1))           ;弧起点
      (setq p2 (vlax-curve-getendPoint e1))             ;弧终点
      (setq s1 (ssadd e1))
      (setq s1 (ssadd (Ent:Make_Line p1 p2) S1))

      (setq o2 (vla-copy o1))                           ;拷贝圆弧用来测试扇形
      (setq s2 (ssadd (vlax-vla-object->ename o2)))
      (setq s2 (ssadd (Ent:Make_Line p1 C) s2))
      (setq s2 (ssadd (Ent:Make_Line p2 C) s2))

      (command "region" s1 "")                          ;弓形计算与建模做比较
      (setq o3 (vlax-ename->vla-object (entlast)))
      (command "region" s2 "")                          ;扇形计算与建模做比较
      (setq o4 (vlax-ename->vla-object (entlast)))

      (Ent:MakePoint-1 (car V3) 1)                      ;计算出来的弓形质心
      (Ent:MakePoint-1 (car V4) 2)                      ;计算出来的扇形质心
      (Ent:MakePoint-1 (vlax-get o3 'centroid) 3)       ;弓形建模的质心
      (Ent:MakePoint-1 (vlax-get o4 'centroid) 4)       ;扇形建模的质心

      (princ (list V3 (vla-get-area O3) (vla-get-perimeter O3)))
      (princ (list V4 (vla-get-area O4) (vla-get-perimeter O4)))
      (princ)
    )
  )
)
;;;测试3点的行列式
(defun c:ttt()
  (initget 1)
  (setq p1 (getpoint "\n1:"))
  (initget 1)
  (setq p2 (getpoint p1 "\n2:"))
  (initget 1)
  (setq p3 (getpoint "\n3:"))

  (setq s (MISC:Test 100000
                     '((TRI:Det3p p1 p2 p3))
          )
  )
  (princ (mapcar 'last s))
  (princ)
)
;;;获取截面的质心
(defun C:GetRegionCentroid (/ sel ent obj i)
  (setq i -1)
  (if (setq sel (ssget '((0 . "REGION"))))
    (repeat (sslength sel)
      (setq ent (ssname sel (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ent))
      (Ent:MakePoint-1 (vlax-get obj 'Centroid) 3)
    )
  )
)
[/pcode]

处处问题鸟

这个在计算几何关系时非常有用！支持！收藏了！

炫翔

{:soso_e179:}很赞，精辟，支持！

PLgis

篇篇精彩，学习！

xtdwynij

学习了!不错!

sachindkini

Dear sir,

nice

liuyun242

不错，谢谢分享

清风明月10

楼主真是无私奉献啊！谢谢了！
都是一些几何学的基本问题，应用面是很广的

yhly555

写得太好了，不支持一下太对不起作者了。

freedake

这个确实要加精！学习了！！{:soso_e179:}

txc6853234

学习学习了！谢谢无私分享！！！！

dbqtju

学习了!不错

laiz3000

先收藏学习一下:)

14702470

太好了，真的感谢楼主无私奉献。对小弟很大帮助