[编程交流] 测量两个pl之间的角度

(defun c:apl (/ osave p1 p2 p3 p4 p5 p6 px py pz pperp p2perp)
(setq osave (getvar "OSMODE"))
(command ".UCS" "")
(setq p1 (getpoint "\n Get first point on first plane"))
(setq p2 (getpoint "\n Get second point"))
(setq p3 (getpoint "\n Get third point"))
(setq p4 (getpoint "\n Get first point on second plane"))
(setq p5 (getpoint "\n Get second point"))
(setq p6 (getpoint "\n Get third point"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(setq p1w p1)
(command ".UCS" 3 p1 p2 p3)
(setq p1 (trans p1 0 1))
(command ".UCS" "O" p1)
(setq px (car p1))
(setq py (cadr p1))
(setq pz (caddr p1))
(setq pperp (list px py (+ pz 1.0)))
(command "line" (list 0 0 0) pperp "")
(setq fline (entlast))
(command ".UCS" "")
(command ".UCS" 3 p4 p5 p6)
(setq p4 (trans p4 0 1))
(command ".UCS" "O" p4)
(setq px (car p4))
(setq py (cadr p4))
(setq pz (caddr p4))
(setq p2perp (list px py (+ pz 1.0))) 
(command "line" (list 0 0 0) p2perp "")
(setq p1w (trans p1w 0 1))
(command ".MOVE" (entlast) "" (list 0 0 0) p1w)
(setq fn (entget fline))
(setq f1 (cdr (assoc 10 fn)))
(setq f2 (cdr (assoc 11 fn)))
(setq ln (entget (entlast)))
(setq f4 (cdr (assoc 11 ln)))
(command ".UCS" "")
(command ".UCS" 3 f1 f2 f4)
(setq f1 (trans f1 0 1))
(setq f2 (trans f2 0 1))
(setq f4 (trans f4 0 1))
(setq ang1 (angle f1 f2))
(setq ang2 (angle f1 f4))
(princ "\nang1 = ")(princ ang1)
(princ "\nang2 = ")(princ ang2)
(setvar "OSMODE" osave)
(setvar "CMDECHO" 1)
(princ)
) 

;; AnglePlanePlane
;; Returns the angle (radians) between two planes (using Al Kashi theorem)
;; the returned angle is always between 0 and pi radians
;;
;; Arguments: the single unit normal vectors of the planes
(defun AnglePlanePlane (nor1 nor2)
 ((lambda (d)
    (acos (/ (- 2 (* d d)) 2))
  )
   (distance nor1 nor2)
 )
)
;;; Acos
;;; Returns the Arc Cosine of number
;;;
;;; Argument: a number between -1 and 1
(defun acos (num)
 (cond
   ((equal num 1 1e-9) 0.0)
   ((equal num -1 1e-9) pi)
   ((< -1 num 1)
    (atan (sqrt (- 1 (expt num 2))) num)
   )
 )
)
;; CrossProduct
;; Returns the cross product (vector) of two vectors
;;
;; Arguments: two vectors
(defun CrossProduct (v1 v2)
 (list    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)
;; Normalize
;; Returns the single unit vector of a vector
;;
;; Argument : un vecteur
(defun Normalize (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)
;; Norm_3Points
;; Returns the single unit normal vector of a plane definedby 3 points
;;
;; Arguments: three points
(defun norm_3pts (p0 p1 p2)
 (Normalize (CrossProduct (mapcar '- p1 p0) (mapcar '- p2 p0)))
)

(defun c:test (/ a)
 (if (vl-catch-all-error-p
       (setq a
              (vl-catch-all-apply
                '(lambda (/ p1 p2 p3 p4 p5 p6)
                   (setq p1 (getpoint "\nFirst point on first plane: ")
                         p2 (getpoint p1 "\nSecond point on first plane: ")
                         p3 (getpoint p1 "\nThird point on first plane: ")
                         p4 (getpoint "\nFirst point on second plane: ")
                         p5 (getpoint p4 "\nSecond point on second plane: ")
                         p6 (getpoint p4 "\nThird point on second plane: ")
                   )
                   (princ
                     (strcat
                       "\nAngle beween planes = "
                       (angtos
                         (AnglePlanePlane (norm_3pts p1 p2 p3) (norm_3pts p4 p5 p6))
                       )
                     )
                   )
                 )
              )
       )
     )
   (princ (strcat "\nerror: " (vl-catch-all-error-message a)))
 )
 (princ)
)

(princ
                     (strcat
                       "\nAngle beween planes = "
                       (angtos
                         (AnglePlanePlane (norm_3pts p1 p2 p3) (norm_3pts p4 p5 p6))
                       )
                     )
                   )

(command "_.text"
                            pause
                            ""
                            ""
                            (angtos
                              (AnglePlanePlane (norm_3pts p1 p2 p3)
                                               (norm_3pts p4 p5 p6)
                              )
                            )
                   )