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

13648893846

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

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

vectra

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

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

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

yuanziyou

vectra 发表于 2017-10-6 20:04
http://bbs.mjtd.com/forum.php?mo ... 954&highlight=trans

这个还是
厉害!

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

xyp1964

(defun c:tt ()                                          ;点到直线的距离
  (setq s1 (car (entsel "\n选择直线: ")))
  (setq p0 (getpoint "\n请输入待求点: "))
  (setq pt (vlax-curve-getclosestpointto s1 p0))
  (setq d1 (distance p0 pt))
  (princ "\n待求点到直线垂足的距离D1为=")
  (princ d1)
  (princ)
)

13648893846

xyp1964 发表于 2017-10-7 11:48
(defun c:tt ()                                          ;点到直线的距离
  (setq s1 (car (entsel "\n ...

版主求延长线上的点有BUG

13648893846

vectra 发表于 2017-10-6 20:04
http://bbs.mjtd.com/forum.php?mo ... 954&highlight=trans

不好意思你的结果点那里都是7.0

evayleung

先AREA求出点ABC的面积，然后*2/BC不就是A点到线BC的距离了么？个人觉得这个方法最简单。

xyp1964

13648893846 发表于 2017-10-7 19:42
版主求延长线上的点有BUG

(defun c:tt ()                                          ;点到直线的距离
  (setq s1 (car (entsel "\n选择直线: ")))
  (setq p0 (getpoint "\n请输入待求点: "))
  (setq pt (vlax-curve-getclosestpointto s1 p0 t))
  (Grvecs (list 1 p0 pt))
  (setq d1 (distance p0 pt))
  (princ "\n待求点到直线垂足的距离D1为=")
  (princ d1)
  (princ)
)

tigcat

支持楼主，这个刚好用的着