[讨论]：[0713]夹角公式转LISP计算

xyz518mm

[讨论]：[0713]夹角公式转LISP计算

最近看了向量夹角公式,拿来CAD计算一下
发现夹角公式好像不太符合.
不知道是我算错了吗?
请各位看看吧~

另外关于里面讲到平行的原则
不知道怎样比对

烦请各位帮忙解答讨论一下~
谢谢~

参考数学公式网站
http://4a.hep.edu.cn/NCourse/gs/calculus1/CHAP7/INDEX.asp

;夹角公式: ???,与cad不符,附件图档的弧度角值,与CAD不符...

(setq divup (abs (+ (* m1 m2) (* n1 n2) (* p1 p2))))
(setq divdn (* (sqrt (+ (expt m1 2) (expt n1 2) (expt p1 2)))
               (sqrt (+ (expt m2 2) (expt n2 2) (expt p2 2)))
               ))

(setq ang (/ divup divdn))

;;;*******************************
;垂直公式:<正确>
(setq ang_90 (+ (* m1 m2) (* n1 n2) (* p1 p2)))

;;;*******************************
;平行公式: ???,不知如何推演
(/ m1 m2) (/ n1 n2) (/ p1 p2)

;;;*******************************

2. 
   
3. (setq en_1 (entget(car (entsel"\n select 1:"))))
   
4. (setq en_2 (entget(car (entsel"\n select 2:"))))
   
5. (setq en_1:10 (cdr (assoc 10 en_1)))
   
6. (setq en_1:11 (cdr (assoc 11 en_1)))
   
7. (setq en_2:10 (cdr (assoc 10 en_2)))
   
8. (setq en_2:11 (cdr (assoc 11 en_2)))
   
9. 
   
10. (setq en_1:10:x (car en_1:10))
    
11. (setq en_1:10:y (cadr en_1:10))
    
12. (setq en_1:10:z (caddr en_1:10))
    
13. 
    
14. (setq en_1:11:x (car en_1:11))
    
15. (setq en_1:11:y (cadr en_1:11))
    
16. (setq en_1:11:z (caddr en_1:11))
    
17. 
    
18. (setq en_2:10:x (car en_2:10))
    
19. (setq en_2:10:y (cadr en_2:10))
    
20. (setq en_2:10:z (caddr en_2:10))
    
21. 
    
22. (setq en_2:11:x (car en_2:11))
    
23. (setq en_2:11:y (cadr en_2:11))
    
24. (setq en_2:11:z (caddr en_2:11))
    
25. 
    
26. (setq m1 (- en_1:10:x en_1:11:x))
    
27. (setq n1 (- en_1:10:y en_1:11:y))
    
28. (setq p1 (- en_1:10:z en_1:11:z))
    
29. 
    
30. (setq m2 (- en_2:10:x en_2:11:x))
    
31. (setq n2 (- en_2:10:y en_2:11:y))
    
32. (setq p2 (- en_2:10:z en_2:11:z))
    

<br /> (setq en_1 (entget(car (entsel"\n select 1:"))))<br /> (setq en_2 (entget(car (entsel"\n select 2:"))))<br /> (setq en_1:10 (cdr (assoc 10 en_1)))<br /> (setq en_1:11 (cdr (assoc 11 en_1)))<br /> (setq en_2:10 (cdr (assoc 10 en_2)))<br /> (setq en_2:11 (cdr (assoc 11 en_2)))<br /> <br /> (setq en_1:10:x (car en_1:10))<br /> (setq en_1:10:y (cadr en_1:10))<br /> (setq en_1:10:z (caddr en_1:10))<br /> <br /> (setq en_1:11:x (car en_1:11))<br /> (setq en_1:11:y (cadr en_1:11))<br /> (setq en_1:11:z (caddr en_1:11))<br /> <br /> (setq en_2:10:x (car en_2:10))<br /> (setq en_2:10:y (cadr en_2:10))<br /> (setq en_2:10:z (caddr en_2:10))<br /> <br /> (setq en_2:11:x (car en_2:11))<br /> (setq en_2:11:y (cadr en_2:11))<br /> (setq en_2:11:z (caddr en_2:11))<br /> <br /> (setq m1 (- en_1:10:x en_1:11:x))<br /> (setq n1 (- en_1:10:y en_1:11:y))<br /> (setq p1 (- en_1:10:z en_1:11:z))<br /> <br /> (setq m2 (- en_2:10:x en_2:11:x))<br /> (setq n2 (- en_2:10:y en_2:11:y))<br /> (setq p2 (- en_2:10:z en_2:11:z))<br />

fsxm

这个以前发过类似贴子~
[php]
;;参数4个坐标点ap1 ap2 bp1 bp2.(全2d or 全3d)
;;返回（向量ap1->ap2）与（向量bp1->bp2）所夹锐角角度.
(defun xn-ang (ap1 ap2 bp1 bp2 / a-> b-> disa disb disa cosab^2 tan@ @)
  (setq a-> (mapcar '- ap1 ap2))
  (setq b-> (mapcar '- bp1 bp2))
  (setq disa (distance a-> '(0 0 0)))
  (setq disb (distance b-> '(0 0 0)))
  (setq        cos@^2
         (expt (abs (/ (apply '+ (mapcar '* a-> b->)) (* disa disb)))
               2
         )
  )
  (if (equal cos@^2 0)
    90.0
    (setq tan@ (expt (/ (- 1 cos@^2) cos@^2) 0.5)
          @    (atan tan@)
          @    (/ (* @ 180) pi)
    )
  )
)
[/php]
当然如果只是验算平行or垂直可以更好办·！
平行<=>向量叉积为0
垂直<=>向量点积为0

xyz518mm

"fsxm"您提过
平行<=>向量叉积为0
垂直<=>向量点积为0

但有2个疑问
01.向量叉积计算如何为0呢?返回值是座标的(0,0,0)吧!
02.向量叉积的两线如果不等长,似乎会没结果喔!是否要加上斜率判断呢?

以上的问题我用下面程序练习
若有出错请各位高手也可帮忙解答讨论一下吧~

2. 
   
3. (defun VecCross (TVectorV1 TVectorV2) ;向量外积
   
4. (setq v1 tvectorv1)
   
5. (setq v2 tvectorv2)
   
6. (setq cx (- (* (nth 1 v1)(nth 2 v2)) (* (nth 1 v2)(nth 2 v1))))
   
7. (setq cy (- (* (nth 2 v1)(nth 0 v2)) (* (nth 2 v2)(nth 0 v1))))
   
8. (setq cz (- (* (nth 0 v1)(nth 1 v2)) (* (nth 0 v2)(nth 1 v1))))
   
9. (setq Cross (list cx cy cz))
   
10. Cross
    
11. )
    
12. 
    
13. (defun C:TEST  ()
    
14. (setq en_1 (entget(car (entsel"\n select 1:"))))
    
15. (setq en_2 (entget(car (entsel"\n select 2:"))))
    
16. (setq en_1:10 (cdr (assoc 10 en_1)))
    
17. (setq en_1:11 (cdr (assoc 11 en_1)))
    
18. (setq en_2:10 (cdr (assoc 10 en_2)))
    
19. (setq en_2:11 (cdr (assoc 11 en_2)))
    
20. (setq tvectorv1 (mapcar '- en_1:10 en_1:11))
    
21. (setq tvectorv2 (mapcar '- en_2:10 en_2:11))
    
22. (setq cross (veccross tvectorv1 tvectorv2))
    
23. (if (or (equal cross (list 0.0 0.0 0.0) 0.0))(alert "两线是平行"))
    
24. )
    

<br /> (defun VecCross (TVectorV1 TVectorV2) ;向量外积<br /> (setq v1 tvectorv1)<br /> (setq v2 tvectorv2)<br /> (setq cx (- (* (nth 1 v1)(nth 2 v2)) (* (nth 1 v2)(nth 2 v1))))<br /> (setq cy (- (* (nth 2 v1)(nth 0 v2)) (* (nth 2 v2)(nth 0 v1))))<br /> (setq cz (- (* (nth 0 v1)(nth 1 v2)) (* (nth 0 v2)(nth 1 v1))))<br /> (setq Cross (list cx cy cz))<br /> Cross<br /> )<br /> <br /> (defun C:TEST  ()<br /> (setq en_1 (entget(car (entsel"\n select 1:"))))<br /> (setq en_2 (entget(car (entsel"\n select 2:"))))<br /> (setq en_1:10 (cdr (assoc 10 en_1)))<br /> (setq en_1:11 (cdr (assoc 11 en_1)))<br /> (setq en_2:10 (cdr (assoc 10 en_2)))<br /> (setq en_2:11 (cdr (assoc 11 en_2)))<br /> (setq tvectorv1 (mapcar '- en_1:10 en_1:11))<br /> (setq tvectorv2 (mapcar '- en_2:10 en_2:11))<br /> (setq cross (veccross tvectorv1 tvectorv2))<br /> (if (or (equal cross (list 0.0 0.0 0.0) 0.0))(alert "两线是平行"))<br /> )<br />