一组几何图形算法

marting · 发表于 2017-3-31 19:04:21

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;向量差积
(defun v^v (u v)
(list
(- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
(- (* (car v) (caddr u)) (* (car u) (caddr v)))
(- (* (car u) (cadr v)) (* (car v) (cadr u)))
)
)
;单位向量
(defun unit (v)
(mapcar '(lambda (x) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
;四点是否共面
(defun Coplanar-p (p1 p2 p3 p4)
(
(lambda (n1 n2)
(equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8)
)
(v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
(v^v (mapcar '- p1 p2) (mapcar '- p1 p4))
)
)
;点是否在三角形内部
(defun ptinsidetriangle-p (pt p1 p2 p3)
(if
(and
(Coplanar-p pt p1 p2 p3)
(not
(or
(inters pt p1 p2 p3)
(inters pt p2 p1 p3)
(inters pt p3 p1 p2)
)
)
(not
(or
(> (+ (distance pt p1) (distance pt p2))
(+ (distance p3 p1) (distance p3 p2))
)
(> (+ (distance pt p2) (distance pt p3))
(+ (distance p1 p2) (distance p1 p3))
)
(> (+ (distance pt p3) (distance pt p1))
(+ (distance p2 p3) (distance p2 p1))
)
)
)
)
T
nil
)
)
;点是否在线上
(defun ptonline-p (pt p1 p2)
(equal (distance p1 p2)
(+ (distance pt p1) (distance pt p2))
1e-7
)
)

;向量差积 
(defun v^v (u v) 
  (list 
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u))) 
    (- (* (car v) (caddr u)) (* (car u) (caddr v))) 
    (- (* (car u) (cadr v)) (* (car v) (cadr u))) 
  ) 
) 
;单位向量 
(defun unit (v) 
  (mapcar '(lambda (x) (/ x (distance '(0.0 0.0 0.0) v))) v) 
) 
;四点是否共面 
(defun Coplanar-p (p1 p2 p3 p4) 
  ( 
   (lambda (n1 n2) 
     (equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8) 
   ) 
    (v^v (mapcar '- p1 p2) (mapcar '- p1 p3)) 
    (v^v (mapcar '- p1 p2) (mapcar '- p1 p4)) 
  ) 
) 
;点是否在三角形内部 
(defun ptinsidetriangle-p (pt p1 p2 p3) 
  (if 
    (and 
      (Coplanar-p pt p1 p2 p3) 
      (not 
        (or 
          (inters pt p1 p2 p3) 
          (inters pt p2 p1 p3) 
          (inters pt p3 p1 p2) 
        ) 
      ) 
      (not 
        (or 
          (> (+ (distance pt p1) (distance pt p2)) 
             (+ (distance p3 p1) (distance p3 p2)) 
          ) 
          (> (+ (distance pt p2) (distance pt p3)) 
             (+ (distance p1 p2) (distance p1 p3)) 
          ) 
          (> (+ (distance pt p3) (distance pt p1)) 
             (+ (distance p2 p3) (distance p2 p1)) 
          ) 
        ) 
      ) 
    ) 
     T 
     nil 
  ) 
) 
 
;点是否在线上 
(defun ptonline-p (pt p1 p2) 
  (equal (distance p1 p2) 
         (+ (distance pt p1) (distance pt p2)) 
         1e-7 
  ) 
)

点是否在三角形边上

;点是否在三角形边上
(defun ptontriangle-p (pt p1 p2 p3)
(if
(or
(equal (distance p1 p2)
(+ (distance pt p1) (distance pt p2))
1e-7
)
(equal (distance p2 p3)
(+ (distance pt p2) (distance pt p3))
1e-7
)
(equal (distance p1 p3)
(+ (distance pt p1) (distance pt p3))
1e-7
)
)
T
nil
)
)

sicky111 · 发表于 2017-4-1 01:32:01

啥也不说了，感谢楼主分享哇！

HLCAD · 发表于 2017-4-1 08:10:09

经典好程序！感谢楼主分享！

zhangq_cai1 · 发表于 2017-4-1 08:11:08

正需要，支持楼主大人了！

sh_h · 发表于 2017-4-1 12:41:32

啥也不说了，感谢楼主分享哇！

wwwwxd · 发表于 2017-4-6 16:48:53

啥也不说了，感谢楼主分享哇！

账号		自动登录	找回密码
密码			立即注册

[每日一码] 一组几何图形算法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块