[Đã xong] Lisp xác định vị trí tương đối giữa Plane và Plane trong không gian

[Doan Van Ha 3.202]

Đây là lisp cuối cùng trong bộ lisp dùng để xác định vị trí tương đối giữa Point, Line, Plane trong không gian.

Lisp này dùng để xác định vị trí tương đối giữa 2 Plane trong không gian. Nếu chúng giao nhau thì giao tuyến sẽ được vẽ.

;Doan Van Ha - CADViet.com - Ngay 05/4/2012
;Muc dich: Kiem tra vi tri tuong doi cua 2 mat phang trong khong gian. Ve giao tuyen chung neu ton tai.
(defun C:HA( / l l1 l2 p1 p2 p3 p4 q1 q2 q3 p11 p22 p33 q11 q22 q33)
(vl-load-com) (or cal (arxload "geomcal")) (command "ucs" "w")
(princ "\nChon Plane thu 1...") (CMP) (setq p11 p1 p22 p2 p33 p3)
(princ "\nChon Plane thu 2...") (CMP) (setq q11 p1 q22 p2 q33 p3)
(HA p11 p22 p33 q11 q22 q33)
(princ))
;----- Chon tung Plane.
(defun CMP( / kieu)
(initget "1 2 3") (setq kieu (getkword "\nKieu chon Plane la: [1=3points/2=1line+1point/3=2lines] <1>: "))
(cond
 ((or (= kieu nil) (= kieu "1"))
  (setq p1 (getpoint "\nChon Point thu 1: ")
    		p2 (getpoint "\nChon Point thu 2: ")
    		p3 (getpoint "\nChon Point thu 3: "))
  (if (LM:Collinear-p p1 p2 p3) (alert "3 diem thang hang khong tao thanh mat phang!")))			;Khong tao thanh Plane
 ((= kieu "2")
  (setq l (car (entsel "\nChon Line: "))
    		p1 (getpoint "\nChon Point: ")
    		p2 (cdr (assoc 10 (entget l)))
    		p3 (cdr (assoc 11 (entget l))))
  (if (LM:Collinear-p p1 p2 p3) (alert "3 diem thang hang khong tao thanh mat phang!")))			;Khong tao thanh Plane
 ((= kieu "3")
  (setq l1 (car (entsel "\nChon Line thu 1: "))
    		l2 (car (entsel "\nChon Line thu 2: "))
    		p1 (cdr (assoc 10 (entget l1)))
    		p2 (cdr (assoc 11 (entget l1)))
    		p3 (cdr (assoc 10 (entget l2)))
    		p4 (cdr (assoc 11 (entget l2))))
  (if (not (and (LM:Coplanar-p p1 p2 p3 p4) (or (not (LM:Collinear-p p1 p2 p3)) (not (LM:Collinear-p p1 p2 p4)))))
(alert "2 duong thang khong tao thanh mat phang!")   						;Khong tao thanh Plane
(if (not (LM:Collinear-p p1 p2 p4)) (setq p3 p4))))))
;----- Ve duong XLine la giao tuyen cua 2 mf (p1,p2,p3) va (q1,q2,q3) neu ton tai.
(defun HA(p1 p2 p3 q1 q2 q3)
(if (and (LM:Coplanar-p p1 p2 p3 q1) (LM:Coplanar-p p1 p2 p3 q2) (LM:Coplanar-p p1 p2 p3 q3))
 (alert "2 mat phang nay trung nhau!")							;TH1: 2 Plane trung nhau
 (if (not (INT_P_P p1 p2 p3 q1 q2 q3))
  (alert "2 mat phang nay song song nhau!")							;TH2: 2 Plane ssong nhau
  (progn
(alert "2 mat phang nay giao nhau. \nGiao tuyen se duoc ve!")					;TH3: 2 Plane giao nhau
(INT_P_P p1 p2 p3 q1 q2 q3)
(entmake (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pg1) (cons 11 (cal "vec(pg1,pg2)"))))))))
;----- 1. Collinear-p (3 ®iÓm th¼ng hµng) - Lee Mac, Returns T if p1,p2,p3 are collinear
(defun LM:Collinear-p (p1 p2 p3) ((lambda ( a b c ) (or (equal (+ a B) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 p3) (distance p1 p3)))
;----- 2. Coplanar-p (4 ®iÓm ®ång ph¼ng) - Lee Mac, Returns T if points p1,p2,p3,p4 are coplanar
(defun LM:Coplanar-p (p1 p2 p3 p4) ((lambda (n) (equal (last (trans p3 0 n)) (last (trans p4 0 n)) 1e-8)) (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))))
;----- 3. Vector Cross Product - Lee Mac, Args: u,v - vectors in R^3 (tÝch v« h­íng cña 2 verter)
(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)))))
;----- 4. Line (p1,p2) // Plane (q1,q2,q3): tr¶ vÒ T hoÆc nil. by HA
(defun L//P (p1 p2 q1 q2 q3) (equal 0.0 (apply '+ (mapcar '* (cal "nor(q1,q2,q3)") (mapcar '- p1 p2))) 1e-8))
;----- 5. Inter of Line (p1,p2) vµ Plane (q1,q2,q3), flag lµ cê x¸c ®Þnh cã kÐo dµi p1p2 hay kh«ng (1: kÐo dµi, 0: kh«ng kÐo dµi). by HA
(defun INT_L_P(p1 p2 q1 q2 q3 flag / pg) (if (not (L//P p1 p2 q1 q2 q3)) (progn (setq pg (cal "ilp(p1,p2,q1,q2,q3)")) (if (= flag 1) pg (if  (equal (+ (distance p1 pg) (distance pg p2)) (distance p1 p2) 1e-8) pg nil)))) pg)
;----- 6. Inter of Plane (p1,p2,p3) vµ Plane (q1,q2,q3). by HA
(defun INT_P_P(p1 p2 p3 q1 q2 q3) (cond ((L//P p1 p2 q1 q2 q3) (setq pg1 (cal "ilp(p2,p3,q1,q2,q3)") pg2 (cal "ilp(p3,p1,q1,q2,q3)"))) ((L//P p2 p3 q1 q2 q3) (setq pg1 (cal "ilp(p3,p1,q1,q2,q3)") pg2 (cal "ilp(p1,p2,q1,q2,q3)"))) ((L//P p3 p1 q1 q2 q3) (setq pg1 (cal "ilp(p1,p2,q1,q2,q3)") pg2 (cal "ilp(p2,p3,q1,q2,q3)"))) (T (setq pg1 (cal "ilp(p2,p3,q1,q2,q3)") pg2 (cal "ilp(p3,p1,q1,q2,q3)")))))

P/S: hiệu chỉnh 22h50' ngày 06/4/2012