[编程交流] Intersection Line & Rectangle

;; 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)))   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u))) ));; 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)))