已知直线 的两个端点 (x1,y1)(x2,y2)直线的长度 和圆心(x3,y3)圆半径R,求直线与圆的交点坐标
代码如下:Option Explicit
Private Type MyPoint
x As Single
y As Single
End Type
Private Sub Command1_Click()
Dim MyA As MyPoint
Dim MyB As MyPoint
Dim MyC As MyPoint
Dim myD As MyPoint
Dim K As Double
Dim R As Double
MyA.x = 1000
MyA.y = 1000
MyB.x = 3500
MyB.y = 5000
R = 1500
Me.Line (MyA.x, MyA.y)-(MyB.x, MyB.y), vbGreen
K = (MyA.y - MyB.y) / (MyA.x - MyB.x)
Me.Circle (MyB.x, MyB.y), R, vbRed
myD = stuSlope(MyB, MyA, MyB, K, R)
Me.DrawWidth = 3
Me.Line (myD.x, myD.y)-(myD.x, myD.y), vbBlue
End Sub
''倾斜且线段一点在圆内返回横纵坐标
Private Function stuSlope(MyA As MyPoint, MyB As MyPoint, MyR As MyPoint, ByVal K As Single, ByVal R As Single) As MyPoint
Dim slTemp As MyPoint
Dim slaNx1 As Single, slaNx2 As Single, flaNx As Single, B As Single
''直线截距用于简化后续计算
B = MyA.y - K * (MyA.x)
slaNx1 = (MyR.x - K * (B - MyR.y) + Sqr((1 + K * K) * R * R + 2 * K * (MyR.x) * (MyR.y - B) - ((MyR.y - B) ^ 2) - (K * (MyR.x) ^ 2))) / (1 + K * K)
slaNx2 = (MyR.x - K * (B - MyR.y) - Sqr((1 + K * K) * R * R + 2 * K * (MyR.x) * (MyR.y - B) - ((MyR.y - B) ^ 2) - (K * (MyR.x) ^ 2))) / (1 + K * K)
If (slaNx1 - MyA.x) * (slaNx1 - MyB.x) < 0 Then
flaNx = slaNx1
Else
flaNx = slaNx2
End If
slTemp.x = flaNx
slTemp.y = MyA.y + K * (flaNx - MyA.x)
stuSlope = slTemp
End Function
''计算两点间距离的函数
Private Function flaDis(Myf As MyPoint, Mys As MyPoint) As Single
flaDis = Sqr((Myf.x - Mys.x) ^ 2 + (Myf.y - Mys.y) ^ 2)
End Function
''斜率计算函数
Private Function flaK(MyA As MyPoint, MyB As MyPoint) As Single
flaK = (MyA.y - MyB.y) / (MyA.x - MyB.x)
End Function
''计算直线与圆心距离,SV用于标识斜率是否存在(1为存在0为不存在)
Private Function flaRDis(MyA As MyPoint, MyB As MyPoint, MyR As MyPoint, ByVal K As Single, ByVal SV As Byte) As Single
If SV = 0 Then
flaRDis = Abs(MyR.x - MyA.x)
Else
flaRDis = Abs(K * MyR.x - MyR.y - K * MyA.x + MyA.y) / Sqr((K ^ 2) + 1)
End If
End Function
''直线竖直放置时圆交点的纵坐标计算
Private Function flaVerty(MyA As MyPoint, MyB As MyPoint, MyR As MyPoint, ByVal R As Single) As Single
Dim flaNy1 As Single, flaNy2 As Single
flaNy1 = MyR.y + Sqr((R ^ 2) - ((MyA.x - MyR.x) ^ 2))
flaNy2 = MyR.y - Sqr((R ^ 2) - ((MyA.x - MyR.x) ^ 2))
If (flaNy1 - MyA.y) * (flaNy1 - MyB.y) < 0 Then
flaVerty = flaNy1
Else
flaVerty = flaNy2
End If
End Function
''计算交点的函数
''PN:取负值点和正值点的区分(1为正点0为负点)
''SV:斜率是否存在的区分标志(1为存在0为不存在)
Private Function stuCross(MyA As MyPoint, MyB As MyPoint, MyR As MyPoint, _
ByVal K As Double, ByVal R As Double, ByVal SV As Byte, _
PN As Long) As MyPoint
Dim scTemp As MyPoint
Dim flaCx1 As Double, flaCx2 As Double, flaCy1 As Double, flaCy2 As Double
Dim flaCx As Double, flaCy As Double
Dim B As Double
''先计算斜率存在的情况
If SV = 1 Then
''直线截距用于简化后续计算
B = MyA.y - K * MyA.x
flaCx1 = (MyR.x - K * (B - MyR.y) + Sqr((1 + K * K) * R * R + 2 * K * (MyR.x) * (MyR.y - B) - ((MyR.y - B) ^ 2) - (K * (MyR.x) ^ 2))) / (1 + K * K)
flaCx2 = (MyR.x - K * (B - MyR.y) - Sqr((1 + K * K) * R * R + 2 * K * (MyR.x) * (MyR.y - B) - ((MyR.y - B) ^ 2) - (K * (MyR.x) ^ 2))) / (1 + K * K)
If 1 = PN Then
flaCx = flaCx1
Else
flaCx = flaCx2
flaCy = MyA.y + K * (flaCx - MyA.x)
End If
Else
flaCy1 = MyR.y + Sqr((R ^ 2) - ((MyA.x - MyA.x) ^ 2))
flaCy2 = MyR.y - Sqr((R ^ 2) - ((MyA.x - MyR.x) ^ 2))
If 1 = PN Then
flaCy = flaCy1
Else
flaCy = flaCy2
flaCx = MyA.x
End If
End If
scTemp.x = flaCx
scTemp.y = flaCy
stuCross = scTemp
End Function
结果如下:
大家能帮个忙吗?我想画那个蓝点到绿线与红线交点处,但总是计算不准.
也就是 已知直线 的两个端点 (x1,y1)(x2,y2)直线的长度 和圆心(x3,y3)圆半径R,求直线与圆的交点坐标.
我的代码如上,加个按钮就行了.只是谁帮助更正一下 --------------------编程问答-------------------- 图片在 http://www.mndsoft.com/bbs/UploadFile/TopicFile/200892411221905.jpg --------------------编程问答-------------------- 顶 --------------------编程问答-------------------- [img=http://sz6.photo.store.qq.com/http_imgload.cgi?/rurl4_b=f4bb1288311e6cacc88355f4b8b05a57e49f965bcdb46adf36608b76f53a54d8202370aa78716c6ffce527a8a2272287a7f28a7bda867941af0dd5aa50ae06cc15c4f7f03ba4c888a1cc8c83ee1496a0e92487b7][/img] --------------------编程问答-------------------- 俺做过这个，做了好几天才正确。我是严格按照解析几何的做法做的。
我首先求出直线的一般式方程ax + by + c = 0，再用a, b, c与圆做计算，中间也是解判别式。
补充：VB , 基础类
