[LISP函数-点]：点到空间直线的垂点

eachy

讨论见http://www.xdcad.net/forum/showthread.php?threadid=148499

2. 
   
3. ;|点到空间直线的垂点|;
   
4. (defun ea:ptoln    (p p1 p2 / l1 a b c x y z x1 y1 z1 k)
   
5.   (setq    l1 (mapcar '- p2 p1)        ;直线的方向向量
   
6.     a  (car l1)
   
7.     b  (cadr l1)
   
8.     c  (last l1)
   
9.     x  (car p)
   
10.     y  (cadr p)
    
11.     z  (last p)
    
12.     x1 (car p1)
    
13.     y1 (cadr p1)
    
14.     z1 (last p1)
    
15.   )
    
16.   (if (equal l1 '(0. 0. 0.))   
    
17.    l1
    
18.     (progn(setq k (/ (+ (* a (- x x1))
    
19.             (* b (- y y1))
    
20.             (* c (- z z1))
    
21.          )
    
22.          (+ (* a a)
    
23.             (* b b)
    
24.             (* c c)
    
25.          )
    
26.           )                ;直线参数
    
27.       )
    
28.       (list (+ x1 (* a k))
    
29.         (+ y1 (* b k))
    
30.         (+ z1 (* c k))
    
31.       )
    
32.     )
    
33. ))

<br /> ;|点到空间直线的垂点|;<br /> (defun ea:ptoln    (p p1 p2 / l1 a b c x y z x1 y1 z1 k)<br />   (setq    l1 (mapcar '- p2 p1)        ;直线的方向向量<br />     a  (car l1)<br />     b  (cadr l1)<br />     c  (last l1)<br />     x  (car p)<br />     y  (cadr p)<br />     z  (last p)<br />     x1 (car p1)<br />     y1 (cadr p1)<br />     z1 (last p1)<br />   )<br />   (if (equal l1 '(0. 0. 0.))   <br />    l1<br />     (progn(setq k (/ (+ (* a (- x x1))<br />             (* b (- y y1))<br />             (* c (- z z1))<br />          )<br />          (+ (* a a)<br />             (* b b)<br />             (* c c)<br />          )<br />           )                ;直线参数<br />       )<br />       (list (+ x1 (* a k))<br />         (+ y1 (* b k))<br />         (+ z1 (* c k))<br />       )<br />     )<br /> ))

cable2004

源码是好东西

YueFeng

;功    能：求出点到起点与终点确定线段的距离.                                  ;
;调用格式：($YF_P2DP <点坐标> <起点坐标> <终点坐标>)                          ;
;返 回 值：距离，为正时，点位在线端的上方，为负时在线端的下方。               ;
(Defun $YF_P2DP(Pt SP EP)
   (Car (Trans (MapCar '- Pt SP) 0 (MapCar '- EP SP)))
)   


;功    能：求出点到点1与点2连接线段的垂足坐标.                                ;
;调用格式：($YF_PerP <点坐标> <点1坐标> <点2坐标>)                            ;
;返 回 值：垂足坐标。                                                         ;
(Defun $YF_PerP(P P1 P2)
   (Inters P1 P2 P (Polar P (+ (/ PI 2) (Angle P1 P2)) 100) Nil)
)