[功能] p到p1p2上的垂点

/db_自贡黄明儒_

1. ;;167 [功能] p到p1p2上的垂点  自贡黄明儒
   
2. (defun HH:perPt        (P p1 p2 / pt)
   
3.   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p))  ;highflybir论矩阵
   
4.   (inters p1 p2 p pt nil)       ;垂点  
   
5. )

;;167 [功能] p到p1p2上的垂点  自贡黄明儒<br /> (defun HH:perPt        (P p1 p2 / pt)<br />   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p))  ;highflybir论矩阵<br />   (inters p1 p2 p pt nil)       ;垂点  <br /> )

st788796

(defun pp (p p1 p2 / p0)
  (setq p0 (trans (mapcar '- p p1) 0 (mapcar '- p1 p2)))
  (polar p1 (angle p1 p2) (last p0))
)
二维点，三维点没有测试
原理见高飞鸟 有关Trans说明帖子

/db_自贡黄明儒_

st788796 发表于 2014-1-15 10:52
(defun pp (p p1 p2 / p0)
  (setq p0 (trans (mapcar '- p p1) 0 (mapcar '- p1 p2)))
  (polar p1 (ang ...

你的结果不对吧？

st788796

/db_自贡黄明儒_ 发表于 2014-1-15 11:12
你的结果不对吧？

(trans (mapcar '- p p1) 0 (mapcar '- p2 p1))
以p1为原点，p1p2方向为X轴的一坐标，car 是Y，last是X

st788796

1. (defun Pnt:PerToLine (p p1 p2 / p0)
   
2.   (setq p0 (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
   
3.   (mapcar '+ p1 (list (car p0) (last p0) (cadr p0)))
   
4. )

(defun Pnt:PerToLine (p p1 p2 / p0)<br />   (setq p0 (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))<br />   (mapcar '+ p1 (list (car p0) (last p0) (cadr p0)))<br /> )