通用函数 【点到直线垂足是否在直线上】

llsheng_73

两位高手的切磋让我看得眼花脖子酸，把这一句最关键的(trans (mapcar '- p p1) 0 (mapcar '- p2 p1))抱走了

highflybir

我也来一段代码，速度似乎快一点：
(defun LINE:P-t (p p1 p2 / a b c)
  (setq a (distance p1 p2))
  (setq b (distance p p1))
  (setq c (distance p p2))
  (> (* a a) (abs (* (+ b c) (- b c))))
)

自贡黄明儒和Qjchen的速度差不多。

自贡黄明儒

highflybir 发表于 2014-1-14 16:02
我也来一段代码，速度似乎快一点：
(defun LINE:P-t (p p1 p2 / a b c)
  (setq a (distance p1 p2))

大师又出马了
前面求三边长a b c ，highflybir就是高

highflybir

如果定义了 Line:angle函数

1. (defun Line:Angle (P0 P1 P2 / an)
   
2.   (setq an (abs (- (angle p0 P1) (angle P0 P2))))
   
3.   (if (> an pi)
   
4.     (- (+ pi pi) an)
   
5.     an
   
6.   )
   
7. )
   

(defun Line:Angle (P0 P1 P2 / an)<br />   (setq an (abs (- (angle p0 P1) (angle P0 P2))))<br />   (if (> an pi)<br />     (- (+ pi pi) an)<br />     an<br />   )<br /> )<br />

那么下面的代码速度也还不错：

1. (defun LINE:p-t-2 (p p1 p2 / a)
   
2.   (and
   
3.     (< (Line:angle P1 P0 P2) (* pi 0.5))
   
4.     (< (Line:angle P2 P0 P1) (* pi 0.5))
   
5.   )
   
6. )
   

(defun LINE:p-t-2 (p p1 p2 / a)<br />   (and<br />     (< (Line:angle P1 P0 P2) (* pi 0.5))<br />     (< (Line:angle P2 P0 P1) (* pi 0.5))<br />   )<br /> )<br />

cnks

为什么狂刀怎么结了婚就消失了？

自贡黄明儒

highflybir 发表于 2014-1-14 18:47
如果定义了 Line:angle函数

那么这样也行呀

1. ;;(perIn2p (getpoint) (getpoint)(getpoint))
   
2. (defun perIn2p (P p1 p2)
   
3.   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p));highflybir论矩阵
   
4.   (setq pt (inters p1 p2 p pt nil));垂点
   
5.   (equal (+ (distance p1 pt) (distance p2 pt)) (distance p1 p2) 1e-8)
   
6. )

;;(perIn2p (getpoint) (getpoint)(getpoint))<br /> (defun perIn2p (P p1 p2)<br />   (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p));highflybir论矩阵<br />   (setq pt (inters p1 p2 p pt nil));垂点<br />   (equal (+ (distance p1 pt) (distance p2 pt)) (distance p1 p2) 1e-8)<br /> )

自贡黄明儒

qjchen 发表于 2014-1-13 12:24
挺好的代码啊，建议代码不长的话，直接贴出代码会否更好些。

假如不考虑直线实体，只考虑 p点投影是否在 ...

不考虑直线实体,适于任何曲线了,这具有重要意义，楼主可以把直线改为曲线了

1. ;;164.47.2 [功能] pt到曲线的垂点不在延长线上，返回T
   
2. ;;(HH:perPtIn (getpoint) (car(entsel)))
   
3. (defun HH:perPtIn (p curve / P1 P2 PA)
   
4.   (setq p1 (vlax-curve-getClosestPointTo curve p))
   
5.   (setq pa (vlax-curve-getParamAtPoint curve P1))            ;参数  
   
6.   (setq p2 (mapcar '+ (vlax-curve-getFirstDeriv curve pa) p1)) ;切线上一点
   
7.   (equal (caddr (trans (mapcar '- p p1) 0 (mapcar '- p2 p1))) 0 1e-5)
   
8. )

;;164.47.2 [功能] pt到曲线的垂点不在延长线上，返回T<br /> ;;(HH:perPtIn (getpoint) (car(entsel)))<br /> (defun HH:perPtIn (p curve / P1 P2 PA)<br />   (setq p1 (vlax-curve-getClosestPointTo curve p))<br />   (setq pa (vlax-curve-getParamAtPoint curve P1))            ;参数  <br />   (setq p2 (mapcar '+ (vlax-curve-getFirstDeriv curve pa) p1)) ;切线上一点<br />   (equal (caddr (trans (mapcar '- p p1) 0 (mapcar '- p2 p1))) 0 1e-5)<br /> )

edata

初步测试总结：
以下个人观点，仅供参考，如有疑问，不要找我。
一楼可以，
二楼要改1e-5 为1e-8才准一点
三楼可以
八楼 垂点在端点无效
十二楼 还在测试，有时候可以，有时候垂点在直线端点无效。
十四楼，貌似也是垂点在直线端点无效
十六楼 可以
十七楼 改1e-5 为1e-8才准一点
补上十四楼笔误

• (defun LINE:p-t-2 (p0 p1 p2 / a) ;第一参数与下面的取值变量不一致p改p0或p0改p
  
•   (and
  
•     (< (Line:angle P1 P0 P2) (* pi 0.5))
  
•     (< (Line:angle P2 P0 P1) (* pi 0.5))
  
•   )
  
• 
  
  

)
十六楼缺少的函数

2. (defun MAT:Rot90 (vec)
   
3.   (vl-list* (- (cadr vec)) (car vec) (cddr vec))
   
4. )

(defun MAT:Rot90 (vec)<br />   (vl-list* (- (cadr vec)) (car vec) (cddr vec))<br /> )

老大的鸭梨

为嘛不用osnap?

老大的鸭梨

各位大神，不好意思，唐突了，我小白一个 。osnap可以取到垂足的点。。。