点到直线的距离，求大神优化，第一次写的

13648893846 · 发表于 2017-10-6 12:54:25

点到线的距离，求大神优化，第一次写的

xyp1964 · 发表于 2017-10-11 12:51:07

;; 点到两点连线的距离
(defun abc (p0 p1 p2 / p3)
(setq p3 (polar p0 (+ (angle p1 p2) (* pi 0.5)) 1))
(distance (inters p1 p2 p0 p3 nil) p0)
)

vectra · 发表于 2017-10-6 20:04:35

本帖最后由 vectra 于 2017-10-6 20:06 编辑

(defun c:tt ()
(setq p1 (getpoint "\n请选择直线起点："))
(setq p2 (getpoint "\n请选择直线第二点："))
(setq p3 (getpoint "\n请输入待求点："))
(abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))
)

http://bbs.mjtd.com/forum.php?mo ... 954&highlight=trans

yuanziyou · 发表于 2017-10-6 16:38:53

本帖最后由 yuanziyou 于 2017-10-6 20:44 编辑

用内置的曲线函数：

(defun c:fgg ();点到直线的距离
(vl-load-com)
(setq objen (car (entsel "请选择直线")))
(setq pt2 (getpoint "\n指定点:"))
(setq pt (vlax-curve-getClosestPointTo objen pt2 T))
(setq d1 (rtos (distance pt pt2) 2 3))
(setq d2 (rtos (distance pt (vlax-curve-getStartPoint objen)) 2 3))
(princ "\n垂足到起点的距离D2为=") (princ d2) (princ)
(princ "\n待求点到直线垂足的距离D1为=") (princ d1) (princ)
)

因为我最近也在写关于点到多段线的,也可以用矢量法：

(defun c:p2l ();点到直线的距离 (setq pt1 (getpoint "\n请选择直线起点："))
(setq pt2 (getpoint "\n请选择直线第二点："))
(setq pt3 (getpoint "\n请输入待求点："))
(setq x1 (car pt1));获取点列表的第一个元素
(setq y1 (cadr pt1));获取点列表的第二个元素
(setq x2 (car pt2));获取点列表的第一个元素
(setq y2 (cadr pt2));获取点列表的第二个元素
(setq x3 (car pt3));获取点列表的第一个元素
(setq y3 (cadr pt3));获取点列表的第二个元素
(setq d1 (P2LDist x1, y1, x2, y2, x3, y3)
d3 (distance pt1 pt3)
)
(if (< (- d3 (abs d1)) 0.00001)
(setq d2 0)
(setq d2 (sqrt (- (* d3 d3) (* d1 d1))))
)
(princ "\n垂足到起点的距离D2为=") (princ (rtos d2 2 3)) (princ)
(princ "\n待求点到直线垂足的距离D1为=") (princ (rtos (abs d1) 2 3)) (princ)
)
(defun P2LDist(x1, y1, x2, y2, x3, y3);点到直线的距离左+右-
(setq r0(Sqrt (+ (* ( - y2 y1) ( - y2 y1)) (* (- x1 x2) (- x1 x2)))));直线起点到终点的距离
(setq a1(-(* x1 y2) (* x3 (- y2 y1)) (* y3 (- x1 x2)) (* x2 y1)))
(setq distL (/ a1 r0))
)

(defun c:p2l ();点到直线的距离  (setq pt1 (getpoint "\n请选择直线起点：")) 
  (setq pt2 (getpoint "\n请选择直线第二点："))   
  (setq pt3 (getpoint "\n请输入待求点：")) 
  (setq x1 (car pt1));获取点列表的第一个元素 
  (setq y1 (cadr pt1));获取点列表的第二个元素 
  (setq x2 (car pt2));获取点列表的第一个元素 
  (setq y2 (cadr pt2));获取点列表的第二个元素 
  (setq x3 (car pt3));获取点列表的第一个元素 
  (setq y3 (cadr pt3));获取点列表的第二个元素 
  (setq d1 (P2LDist x1, y1, x2, y2, x3, y3) 
                d3 (distance pt1 pt3) 
  ) 
  (if (< (- d3 (abs d1)) 0.00001) 
        (setq d2 0) 
          (setq d2 (sqrt (- (* d3 d3) (* d1 d1)))) 
   ) 
  (princ "\n垂足到起点的距离D2为=") (princ (rtos d2 2 3)) (princ)   
  (princ "\n待求点到直线垂足的距离D1为=") (princ (rtos (abs d1) 2 3)) (princ) 
) 
(defun P2LDist(x1, y1, x2, y2, x3, y3);点到直线的距离左+右- 
        (setq r0(Sqrt (+ (* ( - y2 y1) ( - y2 y1)) (* (- x1 x2) (- x1 x2)))));直线起点到终点的距离 
        (setq a1(-(* x1 y2) (* x3 (- y2 y1)) (* y3 (- x1 x2)) (* x2 y1))) 
        (setq distL (/ a1 r0)) 
)

asen · 发表于 2017-10-6 15:50:22

太复杂, 给你个简单思路

假设A为点, B和C为两点直线

求BC角度, 然后加90度求过A点的直线上的一点(polar), 然后求四点交点(inter)即为垂足点, 然后求A到垂足点距离(distance)

asen · 发表于 2017-10-6 17:35:18

另一种方法求垂足点

(defun ::perPoint(p0 p1 p2 / a)
(setq a(mapcar '- p1 p2))
(inters(mapcar '+ (list(-(cadr a))(car a)(caddr a)) p0) p0 p1 p2 nil)
)

13648893846 · 发表于 2017-10-6 18:32:16

asen 发表于 2017-10-6 15:50
太复杂, 给你个简单思路

假设A为点, B和C为两点直线

那个已经能算，因为是第一次写，只是要优化而已

13648893846 · 发表于 2017-10-6 18:47:42

asen 发表于 2017-10-6 17:35
另一种方法求垂足点

(defun ::perPoint(p0 p1 p2 / a)

谢谢，又学得一个大招

13648893846 · 发表于 2017-10-6 19:01:56

yuanziyou 发表于 2017-10-6 16:38
用内置的曲线函数：

你看看你的能计算这个位置吗

yuanziyou · 发表于 2017-10-6 19:49:09

13648893846 发表于 2017-10-6 19:01
你看看你的能计算这个位置吗

重新修改了下,你再试试

13648893846 · 发表于 2017-10-6 19:51:16

yuanziyou 发表于 2017-10-6 19:49
重新修改了下,你再试试

谢谢你大神

13648893846 · 发表于 2017-10-6 20:01:14

yuanziyou 发表于 2017-10-6 19:49
重新修改了下,你再试试

还有另一个BUG,当待求点垂直于起点时还是错误

账号		自动登录	找回密码
密码			注册

[源码] 点到直线的距离，求大神优化，第一次写的

本帖子中包含更多资源

本帖被以下淘专辑推荐:

本帖子中包含更多资源