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 dd00 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)画初的不是点到直线的垂线而是直接连接了点到直线的起点。我事先应经把捕捉模式设为捕捉垂足了
请问是怎么回事?谢谢!

雪山飞狐_lzh 发表于 2004-10-29 10:52:00

VBA的方法和捕捉模式无关

wxp20032003 发表于 2010-5-22 09:02:00


跟我想的一样嘻嘻

zzyong00 发表于 2010-5-26 15:33:00

编程还得会点数学地........
页: [1]
查看完整版本: [求助]请教,有没有直接求点到直线的垂足方法?