Ah yes, my current code assumes an infinite line -
I've updated the code to add an 'onseg' argument to my IntersLinePlane function:
;; Line In Rectangle - Lee Mac 2011;; Args: l1,l2 - points defining the Line;; p1,p2,p3,p4 - points defining the Rectangle(defun LineInRectangle-p ( l1 l2 p1 p2 p3 p4 / i ) (and (setq i (IntersLinePlane l1 l2 p1 p2 p3 T)) ( (lambda ( points ) (apply 'InsideRectangle-p (cons (car points) (mapcar (function (lambda ( op ) (apply 'mapcar (cons op (cdr points)))) ) '(min max) ) ) ) ) ( (lambda ( norm ) (mapcar (function (lambda ( p ) (trans p 0 norm)) ) (list i p1 p2 p3 p4) ) ) (unit (v^v (mapcar '- p3 p2) (mapcar '- p1 p2))) ) ) ));; Point Inside Rectangle - Lee Mac 2011;; Args: pt - point to test;; ll, ur - lower-left & upper-right of rectangle(defun InsideRectangle-p ( pt ll ur ) (and (apply '< (mapcar 'car(list ll pt ur))) (apply '< (mapcar 'cadr (list ll pt ur))) ));; Intersection between Line & Plane - Lee Mac 2011;; Args: l1,l2 - points defining the Line;; p1,p2,p3 - points defining the Plane;; onseg - if nil, lines are considered infinite in length(defun IntersLinePlane ( l1 l2 p1 p2 p3 onseg / n v d ) (setq n (unit (v^v (mapcar '- p3 p2) (mapcar '- p1 p2)))) (setq v (unit (mapcar '- l2 l1))) (if (not (equal 0.0 (setq d (vxv n v)) 1e-) (if onseg (if (< 0.0 (setq d (/ (vxv (mapcar '- p1 l1) n) d)) (norm (mapcar '- l2 l1))) (mapcar '+ l1 (vxs v d)) ) (mapcar '+ l1 (vxs v d)) ) )) ;; Vector Cross (Wedge) Product - Lee Mac 2010;; Args: u,v - vectors in R^3(defun v^v ( u v ) (list (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u))) (- (* (carv) (caddr u)) (* (caru) (caddr v))) (- (* (caru) (cadrv)) (* (carv) (cadru))) ));; Vector Norm - Lee Mac 2010;; Args: v - vector in R^n(defun norm ( v ) (sqrt (apply '+ (mapcar '* v v))));; Unit Vector - Lee Mac 2010;; Args: v - vector in R^n(defun unit ( v ) ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v)));; Vector x Scalar - Lee Mac 2010;; Args: v - vector in R^n, s - real scalar(defun vxs ( v s ) (mapcar '(lambda ( n ) (* n s)) v));; Vector Dot Product - Lee Mac 2010;; Args: u,v - vectors in R^n(defun vxv ( u v ) (apply '+ (mapcar '* u v)))
页:
1
[2]