利用向量求点到直线垂足的坐标

dtucad

利用向量求点到直线垂足的坐标，可用于三维
没啥技术含量，向量入门知识，希望对新手有用。
水平有限，如有错误，请不吝指正。

2. ;利用向量求点到直线垂足的坐标
   
3. ;参数1：直线起点、终点
   
4. ;参数2：直线外一点
   
5. ;返回值：点到直线垂足的坐标
   
6. (defun footcoord (p1 p2 cp / dis dot-product foot projection v-p v-w)
   
7.   (setq v-w (mapcar '- p2 p1));向量p1-p2
   
8.   (setq v-p (mapcar '- cp p1));向量p1-cp
   
9.   ;计算点到直线的投影比例
   
10.   (setq dot-product (+ (* (car v-p) (car v-w)) (* (cadr v-p) (cadr v-w)) (* (caddr v-p) (caddr v-w))));点乘
    
11.   (setq dis (distance p1 p2))
    
12.   (setq projection (/ dot-product (expt dis 2)))
    
13.   (setq foot (list (+ (car p1) (* (car v-w) projection)) (+ (cadr p1) (* (cadr v-w) projection)) (+ (caddr p1) (* (caddr v-w) projection))));求垂足的坐标
    
14. )
    
15. 
    
16. ;测试用
    
17. (defun c:tt (/ cp dis p1 p2 pt)
    
18.   (if (and
    
19.         (setq p1 (getpoint "\n指定直线起点"))
    
20.         (setq p2 (getpoint p1 "\n指定直线终点"))
    
21.         (setq cp (getpoint "\n指定直线外一点"))
    
22.       )
    
23.     (progn
    
24.       (setq pt (footcoord p1 p2 cp))
    
25.       (princ "\n点到直线的垂足坐标为：")(princ pt)
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )

;利用向量求点到直线垂足的坐标<br /> ;参数1：直线起点、终点<br /> ;参数2：直线外一点<br /> ;返回值：点到直线垂足的坐标<br /> (defun footcoord (p1 p2 cp / dis dot-product foot projection v-p v-w)<br />   (setq v-w (mapcar '- p2 p1));向量p1-p2<br />   (setq v-p (mapcar '- cp p1));向量p1-cp<br />   ;计算点到直线的投影比例<br />   (setq dot-product (+ (* (car v-p) (car v-w)) (* (cadr v-p) (cadr v-w)) (* (caddr v-p) (caddr v-w))));点乘<br />   (setq dis (distance p1 p2))<br />   (setq projection (/ dot-product (expt dis 2)))<br />   (setq foot (list (+ (car p1) (* (car v-w) projection)) (+ (cadr p1) (* (cadr v-w) projection)) (+ (caddr p1) (* (caddr v-w) projection))));求垂足的坐标<br /> )<br /> <br /> ;测试用<br /> (defun c:tt (/ cp dis p1 p2 pt)<br />   (if (and <br />         (setq p1 (getpoint "\n指定直线起点"))<br />         (setq p2 (getpoint p1 "\n指定直线终点"))<br />         (setq cp (getpoint "\n指定直线外一点"))<br />       )<br />     (progn<br />       (setq pt (footcoord p1 p2 cp))<br />       (princ "\n点到直线的垂足坐标为：")(princ pt)<br />     )<br />   )<br />   (princ)<br /> )

dtucad

谢谢大佬的优化建议，下次手动优化一下(gpt的码确实不够简洁，但是整体流程还是非常清晰)，谢谢大佬

2. ;利用向量求点到直线垂足的坐标
   
3. ;参数1：直线起点、终点
   
4. ;参数2：直线外一点
   
5. ;返回值：点到直线垂足的坐标
   
6. (defun footcoord (p1 p2 cp / dis dot-product foot projection v-p v-w)
   
7.   (setq v-w (mapcar '- p2 p1));向量p1-p2
   
8.   (setq v-p (mapcar '- cp p1));向量p1-cp
   
9.   ;计算点到直线的投影比例
   
10.   
    
11.   ;(setq dot-product (+ (* (car v-p) (car v-w)) (* (cadr v-p) (cadr v-w)) (* (caddr v-p) (caddr v-w))));点乘
    
12.   (setq dot-product (apply '+ (mapcar '* v-w v-p)));点乘
    
13.   (setq dis (distance p1 p2))
    
14.   (setq projection (/ dot-product (expt dis 2)))
    
15.   ;(setq foot (list (+ (car p1) (* (car v-w) projection)) (+ (cadr p1) (* (cadr v-w) projection)) (+ (caddr p1) (* (caddr v-w) projection))));求垂足的坐标
    
16.   (mapcar '(lambda (x y)(+ x (* y projection))) p1 v-w);求垂足的坐标
    
17. )

;利用向量求点到直线垂足的坐标<br /> ;参数1：直线起点、终点<br /> ;参数2：直线外一点<br /> ;返回值：点到直线垂足的坐标<br /> (defun footcoord (p1 p2 cp / dis dot-product foot projection v-p v-w)<br />   (setq v-w (mapcar '- p2 p1));向量p1-p2<br />   (setq v-p (mapcar '- cp p1));向量p1-cp<br />   ;计算点到直线的投影比例<br />   <br />   ;(setq dot-product (+ (* (car v-p) (car v-w)) (* (cadr v-p) (cadr v-w)) (* (caddr v-p) (caddr v-w))));点乘<br />   (setq dot-product (apply '+ (mapcar '* v-w v-p)));点乘<br />   (setq dis (distance p1 p2))<br />   (setq projection (/ dot-product (expt dis 2)))<br />   ;(setq foot (list (+ (car p1) (* (car v-w) projection)) (+ (cadr p1) (* (cadr v-w) projection)) (+ (caddr p1) (* (caddr v-w) projection))));求垂足的坐标<br />   (mapcar '(lambda (x y)(+ x (* y projection))) p1 v-w);求垂足的坐标<br /> )

xyp1964

vormittag 发表于 2023-9-17 19:40
如果垂足不在曲线上，找到的就是曲线比较近的端点。比如直线两点是 (-1,0) 和 (1,0)，点 P 是 (5,3)，得 ...

(vlax-curve-getClosestPointTo curve givenPnt [extend])

功能
    返回曲线上离指定点最近的点（在 WCS 上）。

说明
1）参数 curve为要测量的对象。
2）参数 givenPnt 为点（在 WCS 上），寻找曲线上距该点最近的点。
3）参数 extend 若指定该参数且其值不为 nil，那么 vlax-curve-getClosestPointTo  在搜索最近点时扩展曲线。

xyp1964

1. (defun PtPer2Pt (p0 p1 p2 / s1 pt)
   
2.   "点到两点的垂足"
   
3.   (command "line" "non" p1 "non" p2 "")
   
4.   (setq pt (vlax-curve-getclosestpointto (setq s1 (entlast)) p0 t)); 参数 t 在搜索最近点时扩展曲线
   
5.   (entdel s1)
   
6.   pt
   
7. )

(defun PtPer2Pt (p0 p1 p2 / s1 pt)<br />   "点到两点的垂足"<br />   (command "line" "non" p1 "non" p2 "")<br />   (setq pt (vlax-curve-getclosestpointto (setq s1 (entlast)) p0 t)); 参数 t 在搜索最近点时扩展曲线<br />   (entdel s1)<br />   pt<br /> )

xyp1964

代码太复杂了

dtucad

院长 这样最快(getdist)

xyp1964

dtucad 发表于 2023-9-12 22:29
院长 这样最快(getdist)

(getdist)完全两码事

dtucad

vlax-curve-getclosestpointto的实现原理倒是可以研究一下
大量程序运算 为了节省代码 还去画线 本末倒置了
可能一会又有人说用trans了 好吧好吧 轮子最香 我爱轮子

塔门说

另一个思路

2. (defun get-perp_pt (pt p1 p2 / vec);
   
3.   (setq vec (mapcar '- p2 p1))
   
4.   (inters pt (mapcar '+ pt (vl-list* (- (cadr vec)) (car vec) (cddr vec))) p1 p2 nil)
   
5. )

(defun get-perp_pt (pt p1 p2 / vec);<br />   (setq vec (mapcar '- p2 p1))<br />   (inters pt (mapcar '+ pt (vl-list* (- (cadr vec)) (car vec) (cddr vec))) p1 p2 nil)<br /> )

vormittag

vlax-curve-getclosestpointto 在很多情况下得到的不是垂足，说不定是一个端点。

vormittag

vormittag 发表于 2023-9-14 17:11
vlax-curve-getclosestpointto 在很多情况下得到的不是垂足，说不定是一个端点。

如果垂足不在曲线上，找到的就是曲线比较近的端点。比如直线两点是 (-1,0) 和 (1,0)，点 P 是 (5,3)，得到的点不是(5,0) 而是 (1,0)