[编程交流] 交点和

;_ilt  = intersection line and 3dface
;by marko_ribar
;link:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/to-get-intersection-between-a-line-and-a-3dface/td-p/2745633/page/3
;
(defun _ilt ( p1 p2 t1 t2 t3 / v^v unit Coplanar-p ptinsidetriangle-p ptontriangle-p ptonline-p _ilp nor o )
 (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-
     )
     (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 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
   )
 )
 (defun ptonline-p ( pt p1 p2 )
   (equal (distance p1 p2) (+ (distance pt p1) (distance pt p2)) 1e-7)
 )
 (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
   (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
     (progn
       (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
             p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
             op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
             op  (list (car op) (cadr op) (caddr p1p))
             tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
       )
       (if (inters p1p p2p op tp nil)
         (progn
           (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
           p
         )
         nil
       )
     )
     (progn
       (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
       (setq p (trans pp nor 0))
       p
     )
   )
 )
 (setq nor (unit (v^v (mapcar '- t3 t1) (mapcar '- t2 t1))))
 (setq o t1)
 
 (if (_ilp p1 p2 o nor)
   (if 
     (and
       (or
         (ptinsidetriangle-p (_ilp p1 p2 o nor) t1 t2 t3)
         (ptontriangle-p (_ilp p1 p2 o nor) t1 t2 t3)
       )
       (ptonline-p (_ilp p1 p2 o nor) p1 p2)
     )
     (_ilp p1 p2 o nor)
     nil
   )
   nil
 )
)
;;
;;BECAUSE THE 3DFACE HAVE 4 VERTICES (2 the same) WE HAVE TO REMOVE DUPLICATED COMPONENTS
;;
;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.
(defun remove_doubles  (lst /)
(vl-load-com)
 (if lst
   (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))))
;;
;;Main program
(defun c:bum ()
(print "pick 3dFace")
(setq ssSelections (ssget))
(setq Point (getpoint "\nPICK A POINT"))
(setq Point2 (list        (nth 0 Point) ; Point i Point2 = line of 500 length (Line that crosses 3dface)
                                (nth 1 Point)
                                500))
(repeat        (setq        intCount (sslength ssSelections))
        (setq        intCount     (1- intCount)
                        entSelection (ssname ssSelections intCount)
                        lstEntity    (entget entSelection))
        ;3DFACE vertices 
        (setq P10         (list         (nth 1 (assoc 10 lstEntity))
                                                (nth 2 (assoc 10 lstEntity))
                                                (nth 3 (assoc 10 lstEntity)) )
                  P11        (list         (nth 1 (assoc 11 lstEntity))
                                                (nth 2 (assoc 11 lstEntity))
                                                (nth 3 (assoc 11 lstEntity)) )
                  P12        (list         (nth 1 (assoc 12 lstEntity))
                                                (nth 2 (assoc 12 lstEntity))
                                                (nth 3 (assoc 12 lstEntity)) )
                  P13        (list         (nth 1 (assoc 13 lstEntity))
                                                (nth 2 (assoc 13 lstEntity))
                                                (nth 3 (assoc 13 lstEntity)) ))
;List of vertices with one (duplicate) deleted
(setq ListVtx        (remove_doubles (list P10 P11 P12 P13) ))
;Others 3 vertices
(setq P100 (nth 0 ListVtx)
          P101 (nth 1 ListVtx)
          P102 (nth 2 ListVtx))
;Making 3dPoint
(entmake (list '(0 . "POINT") (cons 10 (_ilt Point Point2 P100 P101 P102)) ))
);end repeat
);end bum        
                

;    3 Points To 210 Extrusion Direction (LeeMac)
(defun normal ( p1 p2 p3 )
 (defun vxs ( v s )
   (mapcar '(lambda ( n ) (* n s)) v))
 (defun nrm ( v )
   (sqrt (apply '+ (mapcar '(lambda ( n ) (* n n)) v))))
 (defun one ( v )
   (vxs v (/ 1.0 (nrm v))))
 (defun vcv ( 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)))))
 (one (vcv (mapcar '- p3 p2) (mapcar '- p3 p1))))
(defun c:test (/ p10 p11 f10 f11 f12 ucs pt1 pt2)
 (setq ld (entget line_ename)
      p10 (cdr (assoc 10 ld))
      p11 (cdr (assoc 11 ld)))
 (setq fd (entget face_ename)
      p10 (cdr (assoc 10 ld))
      p11 (cdr (assoc 11 ld))
      p12 (cdr (assoc 12 ld)))
 (setq ucs (normal f10 f11 f12)
       pt1 (trans p10 0 ucs)
       pt2 (trans p11 0 ucs))
 (if (setq ip
       (inters pt1 pt2
              (list (car pt1) (cadr pt1) 0)
              (list (car pt2) (cadr pt2) 0) nil))
       (prin1 ip)
       (alert "Line Does Not Intersect This Plane"))
 (prin1))

(defun c:FaceIntr (/)
;  finds the point of intersection of a line defined by two points and a plane defined by
;  a 3DFace
;  L. Minardi  3/28/2017  
 (princ "\nPlease select 3DFACE and press ENTER.")
 (setq        ss    (ssget)   ; get data for 3Dface
en    (ssname ss 0)
edata (entget en)
 )
 (setq        p1   (getpoint "\nLine Start:")  ; get two line points
p2   (getpoint p1 "\nLine End")
p1p2 (mapcar '- p2 p1)                ; vector from p1 to p2
 )
 (setq        fp1 (cdr (assoc 10 edata))        ;three corners of the 3DFACE
fp2 (cdr (assoc 11 edata))
fp3 (cdr (assoc 12 edata))
 )
 (setq N (cross fp12 fp23))                ; normal to face
 (setq        fp1p1 (mapcar '- p1 fp1)        ; vector from face to line
p1p2  (mapcar '- p2 p1)         ; vector paralled to line
 )                                        
                                ; determine if line is parallel to plane
 (setq Nxp1p2 (cross N p1p2))                ; N cross p1p2
 (setq Ntp1p2 (* (distance '(0 0 0) N) (distance '(0 0 0) p1p2)))
                                ; magnitude N times magnitude p1p2
 (setq
   sinang (/ (distance '(0 0 0) Nxp1p2) Ntp1p2)  ; sine angle between normal and line p1p2
 )
 (if (equal sinang 1.0 0.0001)
   (princ "\nNo intersection, the line is parallel to the face.")
   (progn
     (setq tk (- (/ (dot N fp1p1) (dot N p1p2))) ; value of parameter t at intersection
     )                                        ; intersection point of line and face using parametric definition of a line  
     (setq PInt (mapcar '+
                 p1
                 (mapcar '* (mapcar '- p2 p1) (list tk tk tk))
         )
     )
     (command "point" Pint)
     (command "line" p2 Pint "")
     (setq s (distance p2 Pint))
     (princ "\n The intersection point is located at: ")
     (princ Pint)
     (princ
"\nThe distance from line end point to the intersection is: "
     )
     (princ s)
   )
 )                                        ; end if  
 (princ)
 
)                                        ;end Face-Intr
;;; Compute the cross product of 2 vectors
(defun cross (a b / crs)
 (setq        crs (list
      (- (* (nth 1 a) (nth 2 b))
         (* (nth 1 b) (nth 2 a))
      )
      (- (* (nth 0 b) (nth 2 a))
         (* (nth 0 a) (nth 2 b))
      )
      (- (* (nth 0 a) (nth 1 b))
         (* (nth 0 b) (nth 1 a))
      )
    )                                ;end list
 )                                        ;end setq c
)                                        ;end cross
;;; Compute the dot product of 2 vectors a and b
(defun dot (a b / dd)
 (setq dd (mapcar '* a b))
 (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)                                        ;end of dot