[飞马系列] (立体几何线面交点应用) 三点定面分割三维直线

qjchen · 发表于 2011-12-19 21:21:13

本帖最后由 qjchen 于 2011-12-19 21:23 编辑

以前一段时间，很喜欢向量运算，写了不少立体几何相关的函数

近日刚好有一个项目需要进行一个面切割一堆空间直线。

改造了一下，写成如下函数。可能应用面不广吧，就当是一个小众应用吧。

里面的向量运算，一些是参照前辈们的，一些是自己根据矢量公式写的，

;;;注意：直线和面的交点，有nil和T两个参数，对于T，直线需穿过面才算有交点，nil则不同
;;; 而对于面，此三点定义的面没有大小之分，即是若线在三点外穿过三点定下平面，也
;;; 算有交点

代码同附件

;;;通过三点的空间平面对空间三维线段进行截断
;;;编程：华南理工大学 qjchen，命令:test
;;;日期: 2011.12.19
;;;注意：直线和面的交点，有nil和T两个参数，对于T，直线需穿过面才算有交点，nil则不同
;;; 而对于面，此三点定义的面没有大小之分，即是若线在三点外穿过三点定下平面，也
;;; 算有交点
;;;;;;______________qjchen的一些向量函数________________________________________;;;
(defun q:geo:is-3p-plane(p1 p2 p3)
(> (q:vec:Len (q:vec:Norm (q:vec:cross* (q:vec:- p2 p1) (q:vec:- p3 p1)))) 1e-6)
)
(defun q:geo:is-samepoint(p1 p2) (< (distance p1 p2) 1e-5) )
(defun q:vec:+(v1 v2) (mapcar '+ v1 v2) )
(defun q:vec:-(v1 v2) (mapcar '- v1 v2) )
(defun q:vec:*c(v a) (mapcar '(lambda(x) (* x a)) v) )
(defun q:vec:dot*(v1 v2) (apply '+ (mapcar '* v1 v2)) )
(defun q:vec:cross*(v1 v2)
(list (q:det:2 (cadr v1) (caddr v1) (cadr v2) (caddr v2))
(q:det:2 (caddr v1) (car v1) (caddr v2) (car v2))
(q:det:2 (car v1) (cadr v1) (car v2) (cadr v2)))
)
;;;;cal determinant 计算二阶行列式
;;;;|a1 a2|
;;;;|b1 b2|
(defun q:det:2(a1 a2 b1 b2) (- (* a1 b2) (* a2 b1)))
;;;;Normalize a vector
(defun q:vec:Norm(v / l)
(if (not (zerop (setq l (distance '(0 0 0) v))))
(mapcar '(lambda(x) (/ x l)) v))
)
;;;;Vector Length
(defun q:vec:Len(v / l) (distance '(0 0 0) v))
;;;;a normal to a plane,
(defun q:geo:normal.to.3p(p1 p2 p3)
(if (q:geo:is-3p-plane p1 p2 p3)(q:vec:cross* (q:vec:- p2 p1) (q:vec:- p3 p1)))
)
;;p1 p2是2点，V是截面法线，VP是其上一点，F是是否实际相交
;;参考资料 [url]http://en.wikipedia.org/wiki/Line-plane_intersection[/url]
;;;;;;;;;;;[url]http://softsurfer.com/Archive/algorithm_0104/algorithm_0104B.htm[/url]
(defun q:geo:line-intersect-plane-1(P1 P2 V VP F / d l n)
(setq n (q:vec:Norm V) l (q:vec:Norm (q:vec:- P2 P1)))
(if (not (zerop (q:vec:dot* l n)))
(progn
(setq d (/ (q:vec:dot* (q:vec:- VP P1) n) (q:vec:dot* l n)))
(setq res (q:vec:+ P1 (q:vec:*c l d)))
(setq temp (q:vec:Len (q:vec:- P2 P1)))
(if (and F (or (< d 0) (> d (q:vec:Len (q:vec:- P2 P1))))) (setq res nil))
)
)
res
)
;;;;;;______end of qjchen的一些向量函数__________________________________;;;
(defun q:entmake:point(pt layer)
(entmake (list (cons 0 "POINT")(cons 8 layer)(cons 10 pt)))
)
(defun q:mulentmod (ent numlst contentlst / i x)
(setq i 0)
(foreach x numlst
(if (/= (assoc x ent) nil)
(setq ent (subst (cons x (nth i contentlst)) (assoc x ent) ent ) )
(setq ent (append ent (list (cons x (nth i contentlst))) ) )
)
(setq i (1+ i))
)
(entmod ent) ;(entupd ent)
)
;;;;;stdlib from Reini Urban
(defun std-sslist (ss / n lst)
(if (eq 'pickset (type ss))
(repeat (setq n (fix (sslength ss))) ; fixed
(setq lst (cons (ssname ss (setq n (1- n))) lst))
)
)
)
;;;以三点定下的平面切割一批线，需有实交点
;;;主程序______by qjchen____________________________;;;
(defun c:test()
(setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:") p3 (getpoint "\n第三点:"))
(if (q:geo:is-3p-plane p1 p2 p3)
(progn
(setq c (std-sslist(ssget '((0 . "LINE")))))
(setq pn (q:geo:normal.to.3p p1 p2 p3))
(foreach x c
(setq pa (cdr (assoc 10 (entget x))) pb (cdr (assoc 11 (entget x))))
(setq int (q:geo:line-intersect-plane-1 pa pb pn p1 T))
(if (and int (not (q:geo:is-samepoint int pa))(not (q:geo:is-samepoint int pb)))
(progn
(q:mulentmod (entget (entmakex (entget x))) (list 62 11) (list 1 int))
(q:mulentmod (entget (entmakex (entget x))) (list 62 10) (list 2 int))
(entdel x)
(q:entmake:point int "0")
)
)
)
)
(princ "\n 三点没有组成一个平面.")
)
)
(princ)
(princ "\n 通过三点的空间平面对空间三维线段进行截断，编程：华南理工大学 qjchen，命令:test")
(princ)

;;;通过三点的空间平面对空间三维线段进行截断 
;;;编程：华南理工大学 qjchen，命令:test 
;;;日期: 2011.12.19 
;;;注意：直线和面的交点，有nil和T两个参数，对于T，直线需穿过面才算有交点，nil则不同 
;;;      而对于面，此三点定义的面没有大小之分，即是若线在三点外穿过三点定下平面，也 
;;;      算有交点                                       
;;;;;;______________qjchen的一些向量函数________________________________________;;; 
(defun q:geo:is-3p-plane(p1 p2 p3) 
 (> (q:vec:Len (q:vec:Norm (q:vec:cross* (q:vec:- p2 p1) (q:vec:- p3 p1)))) 1e-6) 
) 
(defun q:geo:is-samepoint(p1 p2) (< (distance p1 p2) 1e-5) ) 
(defun q:vec:+(v1 v2) (mapcar '+ v1 v2) ) 
(defun q:vec:-(v1 v2) (mapcar '- v1 v2) ) 
(defun q:vec:*c(v a) (mapcar '(lambda(x) (* x a)) v) ) 
(defun q:vec:dot*(v1 v2) (apply '+ (mapcar '* v1 v2)) ) 
(defun q:vec:cross*(v1 v2) 
  (list (q:det:2 (cadr v1) (caddr v1) (cadr v2) (caddr v2)) 
        (q:det:2 (caddr v1) (car v1) (caddr v2) (car v2)) 
        (q:det:2 (car v1) (cadr v1) (car v2) (cadr v2))) 
) 
;;;;cal determinant 计算二阶行列式 
;;;;|a1 a2| 
;;;;|b1 b2| 
(defun q:det:2(a1 a2 b1 b2)  (- (* a1 b2) (* a2 b1))) 
;;;;Normalize a vector 
(defun q:vec:Norm(v / l) 
  (if (not (zerop (setq l (distance '(0 0 0) v)))) 
  (mapcar '(lambda(x) (/ x l)) v)) 
) 
;;;;Vector Length 
(defun q:vec:Len(v / l)  (distance '(0 0 0) v)) 
;;;;a normal to a plane, 
(defun q:geo:normal.to.3p(p1 p2 p3) 
  (if (q:geo:is-3p-plane p1 p2 p3)(q:vec:cross* (q:vec:- p2 p1) (q:vec:- p3 p1))) 
) 
;;p1 p2是2点，V是截面法线，VP是其上一点，F是是否实际相交 
;;参考资料 [url]http://en.wikipedia.org/wiki/Line-plane_intersection[/url] 
;;;;;;;;;;;[url]http://softsurfer.com/Archive/algorithm_0104/algorithm_0104B.htm[/url] 
(defun q:geo:line-intersect-plane-1(P1 P2 V VP F / d l n) 
 (setq n (q:vec:Norm V) l (q:vec:Norm (q:vec:- P2 P1))) 
 (if (not (zerop (q:vec:dot* l n))) 
   (progn 
     (setq d (/ (q:vec:dot* (q:vec:- VP P1) n) (q:vec:dot* l n))) 
 
     (setq res (q:vec:+ P1 (q:vec:*c l d))) 
     (setq temp (q:vec:Len (q:vec:- P2 P1))) 
     (if (and F (or (< d 0) (> d (q:vec:Len (q:vec:- P2 P1))))) (setq res nil)) 
   ) 
 ) 
 res 
) 
;;;;;;______end of qjchen的一些向量函数__________________________________;;; 
(defun q:entmake:point(pt layer) 
  (entmake (list (cons 0 "POINT")(cons 8 layer)(cons 10 pt))) 
) 
(defun q:mulentmod (ent numlst contentlst / i x) 
  (setq i 0) 
  (foreach x numlst 
    (if (/= (assoc x ent) nil) 
      (setq ent (subst (cons x (nth i contentlst)) (assoc x ent) ent ) ) 
      (setq ent (append ent (list (cons x (nth i contentlst))) ) ) 
    ) 
    (setq i (1+ i)) 
  ) 
  (entmod ent)  ;(entupd ent) 
) 
;;;;;stdlib from Reini Urban 
(defun std-sslist (ss / n lst) 
  (if (eq 'pickset (type ss)) 
    (repeat (setq n (fix (sslength ss))) ; fixed 
      (setq lst (cons (ssname ss (setq n (1- n))) lst)) 
    ) 
  ) 
) 
;;;以三点定下的平面切割一批线，需有实交点 
;;;主程序______by qjchen____________________________;;; 
(defun c:test() 
  (setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:") p3 (getpoint "\n第三点:")) 
  (if (q:geo:is-3p-plane p1 p2 p3) 
    (progn 
      (setq c (std-sslist(ssget '((0 . "LINE"))))) 
      (setq pn (q:geo:normal.to.3p p1 p2 p3)) 
      (foreach x c 
       (setq pa (cdr (assoc 10 (entget x))) pb (cdr (assoc 11 (entget x)))) 
       (setq int (q:geo:line-intersect-plane-1 pa pb pn p1 T)) 
 
       (if (and int (not (q:geo:is-samepoint int pa))(not (q:geo:is-samepoint int pb))) 
          (progn 
            (q:mulentmod (entget (entmakex (entget x))) (list 62 11) (list 1 int)) 
            (q:mulentmod (entget (entmakex (entget x))) (list 62 10) (list 2 int)) 
            (entdel x) 
            (q:entmake:point int "0") 
         ) 
         ) 
      ) 
    ) 
    (princ "\n 三点没有组成一个平面.") 
  ) 
) 
 
(princ) 
(princ "\n 通过三点的空间平面对空间三维线段进行截断，编程：华南理工大学 qjchen，命令:test") 
(princ)

zst1978 · 发表于 2020-8-24 09:15:59

测量斜面积，我不会啊

chshsl · 发表于 2019-1-23 14:07:02

非常好用，谢谢共享。

chshsl · 发表于 2019-1-21 15:02:57

找了好久，谢谢了。

cnks · 发表于 2011-12-20 00:46:41

顶了

vlisp2012 · 发表于 2011-12-20 20:43:05

终于看到在三维中的应用了！！！必须顶！！！

绣花猪 · 发表于 2012-1-3 00:44:51

早看到这个帖子就好了。俺琢磨了一礼拜哦

wudi · 发表于 2012-7-4 19:51:40

真的很厉害

lidaxiu · 发表于 2012-7-4 19:53:50

楼主好强，学习的楷模

yoyoho · 发表于 2012-7-5 07:10:52

感谢qjchen分享程序!

梦醒才知原是梦 · 发表于 2012-7-5 10:53:50

定个。。。下了。。。嘻嘻~~~

2689326616 · 发表于 2013-4-10 08:16:49

楼主的程序很强大，我测试了一下处于平面外的直线也能剪断啊。T参数和nil参数效果都一样。我想平面外的不要剪断怎么做到？

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

[飞马系列] (立体几何线面交点应用) 三点定面分割三维直线

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

[飞马系列] (立体几何 线面交点 应用) 三点定面 分割 三维直线

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

[飞马系列] (立体几何线面交点应用) 三点定面分割三维直线