[求助]请教，有没有直接求点到直线的垂足方法？

foxlinshan · 发表于 2004-10-24 15:38:00

已知一点的坐标和一条直线的端点坐标想偷懒不计算就能能获得点到直线的垂足坐标
我翻了半天ActiveX与VBA参考手册，找不到相关的方法。
可是cad里面都提供捕捉点到直线的垂足，是不是我没找到而已？
请指教，先谢谢了。

xyp1964 · 发表于 2004-10-24 20:22:00

;;;点到line线的垂足-- chz
(defun c:chz(/ pt s1 pt1-s1 pt2-s1 ang pt-per)
   (while(not(setq pt (getpoint"\n点1 : "))))
   (while(not(setq s1(entsel"选线 : "))))
   (setq pt1-s1 (vlax-curve-getstartPoint (car s1))
   pt2-s1 (vlax-curve-getEndPoint (car s1))
ang (vla-get-angle (vlax-ename->vla-object (car s1)))
pt-per (inters pt1-s1 pt2-s1 pt (polar pt (+ ang (/ pi 2)) 1000) nil)
)
   (dzb pt-per)
   (grvecs (list 1 pt pt-per))
   (princ"\n垂足坐标 : ")
   (princ pt-per)
   (princ)
   )
;;;点坐标处加十字线
(defun dzb(pt1 / ll)
   (SETQ ll 500)
   (grvecs (list 1 (POLAR PT1 0 ll)(POLAR PT1 PI ll)))
   (grvecs (list 1 (POLAR PT1 (/ PI 2) ll)(POLAR PT1 (* PI 1.5) ll)))
   )

foxlinshan · 发表于 2004-10-25 10:09:00

能不能请高手解释一下，我看不明白。
上面这段代码是VBA么？

雪山飞狐_lzh · 发表于 2004-10-25 10:30:00

获取直线角度a－》做过该点的直线，角度为a＋90－》求两直线交点即为垂足

tfyyf · 发表于 2004-10-26 08:58:00

‘请参考我做的五个子程序
Public Function 三点垂足(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, X3 As Double, Y3 As Double) As Variant()
'直线的两端点坐标X1,Y1)-(X2,Y2),已知点X3,Y3)
fw1 = 方位(X1, Y1, X2, Y2)
fw2 = 方位(X1, Y1, X3, Y3)
fw1 = DMS(DEG(fw2) - DEG(fw1))
pj0 = 平距(X1, Y1, X2, Y2)
If pj0 = 0 Then pj0 = 1E-20
Pj1 = 平距(X1, Y1, X3, Y3) * Cos(RAD(fw1))
Var(0) = X1 + (X2 - X1) * Pj1 / pj0
Var(1) = Y1 + (Y2 - Y1) * Pj1 / pj0
三点垂足 = Var
End Function
’求方位角
Function 方位(ddd As Double, ddd0 As Double, ddd1 As Double, ddd2 As Double)
dd = ddd1 - ddd
dd0 = ddd2 - ddd0
If dd0  0 Then
   方位 = DMS(180 - 90 * Sgn(dd0) - Atn(dd / dd0) * 180 / Pi)
Else
   方位 = 0
End If
方位 = 方位 + 360
方位 = 方位 - Int(方位 / 360) * 360
End Function
‘求两点平距
Function 平距(ddd As Double, ddd0 As Double, ddd1 As Double, ddd2 As Double)
平距 = Sqr((ddd - ddd1) ^ 2 + (ddd0 - ddd2) ^ 2)
End Function
Function DEG(dfmm)
dfm = dfmm
If dfm = 0 Then
   DEG = 0
Else
   ddd0 = dfm
   dfm = Abs(dfm) + 0.000001
   'If Int(dfmm * 100) = 13253 Then MsgBox Int(dfm * 10000)
   ddd1 = Int(dfm * 100) - Int(dfm) * 100
   ddd2 = Int(dfm * 10000) - Int(dfm * 100) * 100

   ddd = (Int(dfm) + ddd1 / 60 + ddd2 / 3600) * Abs(ddd0) / ddd0
   DEG = ddd
End If
End Function
Function DMS(dddd)
ddd = dddd
If ddd = 0 Then
   DMS = 0
Else
   ddd0 = ddd
   ddd = Abs(ddd) + 0.000001
   ddd1 = Int(ddd * 100) - Int(ddd) * 100
   ddd2 = (ddd * 10000) - Int(ddd) * 10000 - Int(ddd1) * 100 + (ddd1 * 0.6 - Int(ddd1 * 0.6)) * 100 / 0.6
   ddd = Int(ddd)
   ddd1 = Int(ddd1 * 0.6) / 100
   ddd2 = ddd2 * 0.000036
If ddd2 >= 0.006 Then
   ddd1 = ddd1 + 0.01
   ddd2 = ddd2 - 0.006
End If
If ddd1 >= 0.6 Then
   ddd = ddd + 1
   ddd1 = ddd1 - 0.6
End If
   dfm = (ddd + ddd1 + ddd2) * ddd0 / Abs(ddd0)
   DMS = dfm
End If
End Function

mkhsj928 · 发表于 2004-10-26 09:31:00

Vlisp中用vlax-curve-getClosestPointToProjection最简单
VBA中遗憾好像没有对应的函数，只能用数学方法了。

foxlinshan · 发表于 2004-10-29 10:48:00

版主，看了你们推荐的《VBA开发精彩实例教程》里面135-136页介绍了计算点到只显得距离。我用的那种方法求点坐标，可是用语句set linep＝thisdrawing.modelspace.addline(pt,linet.startpoint)画初的不是点到直线的垂线而是直接连接了点到直线的起点。我事先应经把捕捉模式设为捕捉垂足了
请问是怎么回事？谢谢！