主题:已知三角形A、B两点坐标、BC边长、∠BAC角度,求C点坐标
在QQ群里闲聊时看到的一个问题:已知三角形A、B两点坐标、BC边长、∠BAC角度,求C点坐标。
注:不一定是三角形,也就是说,角度可能是180、0 等等任何可能的值。
无聊自己试着写了下。才发现原来初中、高中的数学知识还是有用的[em1]
主要代码如下。还有一些小错误,
[code=vb]
Option Explicit
Private Type POINT
x As Single
y As Single
End Type
Private Function CalcAC(ByRef pA As POINT, ByRef pB As POINT, ByVal bc As Single, ByVal bac As Single) As Single
'//! 已知一个三角形的A、B两点坐标、BC边长、∠BAC,求另一边AC的长度
Dim ab As Single
Dim ac As Single
Const PI As Single = 3.1415926
ab = CalcDistance(pA, pB)
ac = Sqr(ab ^ 2 + bc ^ 2 - 2 * ab * bc * Cos(bac / 180 * PI))
CalcAC = ac
End Function
Private Sub DrawAxes()
pic1.Cls
pic1.Height = pic1.Width
pic1.BackColor = vbBlack
pic1.AutoRedraw = True
pic1.Scale (-200, 200)-(200, -200)
pic1.ForeColor = vbGreen
pic1.DrawWidth = 1
pic1.Line (-200, 0)-(200, 0)
pic1.Line (190, 10)-(200, 0)
pic1.Line (190, -10)-(200, 0)
pic1.Line (0, -200)-(0, 200)
pic1.Line (10, 190)-(0, 200)
pic1.Line (-10, 190)-(0, 200)
End Sub
Private Sub Command1_Click()
Dim pA As POINT
Dim pB As POINT
Dim bc As Single
Dim bac As Single
Dim pt() As POINT
Dim r As Single
Dim n As Integer
Dim i As Integer
Dim result() As Single
Call DrawAxes
'//:测试
pA.x = 0
pA.y = 0
pB.x = 2
pB.y = 0
Debug.Print GetPoint(pA, 2, pB, 2, pt())
Debug.Print pt(0).x, pt(0).y
Debug.Print pt(1).x, pt(1).y
'Exit Sub
pA.x = txtAx.Text
pA.y = txtAy.Text
pB.x = txtBx.Text
pB.y = txtBy.Text
bc = txtBC.Text
bac = txtBAC.Text
pic1.ForeColor = vbRed
pic1.DrawWidth = 1
pic1.POINT pA.x, pA.y
pic1.POINT pB.x, pB.y
pic1.Line (pA.x, pA.y)-(pB.x, pB.y)
r = CalcAC(pA, pB, bc, bac)
'Label5.Caption = r
pic1.ForeColor = vbYellow
pic1.Circle (pA.x, pA.y), r
pic1.Circle (pB.x, pB.y), bc
n = GetPoint(pA, r, pB, bc, pt())
'Label5.Caption = Label5.Caption & "," & n
pic1.ForeColor = vbMagenta
For i = 0 To n - 1
pic1.POINT pt(i).x, pt(i).y
Debug.Print pt(i).x, pt(i).y
If (CalcDistance(pt(i), pB) - bc) < 0.0000001 Then
pic1.Line (pt(i).x, pt(i).y)-(pB.x, pB.y)
pic1.Line (pt(i).x, pt(i).y)-(pA.x, pA.y)
Label5.Caption = pt(i).x & "," & pt(i).y
'Exit For
Else
Debug.Print "--------", bc, CalcDistance(pt(i), pB)
End If
Next
pic1.ForeColor = vbGreen
If n = 2 Then
pic1.Line (pt(0).x, pt(0).y)-(pt(1).x, pt(1).y)
End If
End Sub
Private Sub Form_Load()
Call DrawAxes
End Sub
Private Function GetPoint(ByRef pA As POINT, ByVal ra As Single, ByRef pB As POINT, ByVal rb As Single, ByRef pt() As POINT) As Long
'//! 获取两个圆的交点
'//! 返回值:交点的个数;交点的坐标通过pt()数组引用返回
'//! 参数:pa,pb两个圆的圆心坐标,ra,rb两个圆的半径
Dim ab As Single
Dim n As Integer
Dim r As Integer
Dim result() As Single
Dim a As Single
Dim b As Single
Dim c As Single
Dim i As Integer
ab = CalcDistance(pA, pB)
If ab > (ra + rb) Or ab < Abs(ra - rb) Then
n = 0
ElseIf (ab < (ra + rb) And ab > Abs(ra - rb)) Then
n = 2
ElseIf (ab = Abs(ra - rb) Or ab = (ra + rb)) Then
n = 1
End If
Dim t As Single
t = ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.y ^ 2
a = 1 + ((pB.y - pA.y) / (pB.x - pA.x)) ^ 2
b = -1 * (2 * ((pB.y - pA.y) / (pB.x - pA.x)) * ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) + 2 * pA.y)
c = ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) ^ 2 + pA.y ^ 2 - ra ^ 2
r = CalcFangCheng(a, b, c, result())
Debug.Assert r = n
If r > 0 Then
ReDim pt(r - 1) As POINT
For i = 0 To r - 1
pt(i).y = result(i)
pt(i).x = ((ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.x ^ 2) - (2 * pB.y - 2 * pA.y) * pt(i).y) / (2 * pB.x - 2 * pA.x)
Next
End If
GetPoint = n
End Function
Private Function CalcDistance(ByRef pA As POINT, ByRef pB As POINT) As Single
'//! 计算平面内两点的距离
CalcDistance = Sqr((pB.x - pA.x) ^ 2 + (pB.y - pA.y) ^ 2)
End Function
Private Function CalcFangCheng(ByVal a As Single, ByVal b As Single, ByVal c As Single, ByRef result() As Single) As Long
'//! 解方程ax^2 + bx + c = 0
Dim n As Integer
Dim delta As Single
delta = b ^ 2 - 4 * a * c
If delta < 0 Then
n = 0
ElseIf delta > 0 Then
n = 2
ReDim result(1) As Single
result(0) = (b * (-1) + Sqr(delta)) / (2 * a)
result(1) = (b * (-1) - Sqr(delta)) / (2 * a)
Else
n = 1
ReDim result(0) As Single
result(0) = b * (-1) / (2 * a)
End If
CalcFangCheng = n
End Function
[/code]
[em1][em1][em1][em1]
注:不一定是三角形,也就是说,角度可能是180、0 等等任何可能的值。
无聊自己试着写了下。才发现原来初中、高中的数学知识还是有用的[em1]
主要代码如下。还有一些小错误,
[code=vb]
Option Explicit
Private Type POINT
x As Single
y As Single
End Type
Private Function CalcAC(ByRef pA As POINT, ByRef pB As POINT, ByVal bc As Single, ByVal bac As Single) As Single
'//! 已知一个三角形的A、B两点坐标、BC边长、∠BAC,求另一边AC的长度
Dim ab As Single
Dim ac As Single
Const PI As Single = 3.1415926
ab = CalcDistance(pA, pB)
ac = Sqr(ab ^ 2 + bc ^ 2 - 2 * ab * bc * Cos(bac / 180 * PI))
CalcAC = ac
End Function
Private Sub DrawAxes()
pic1.Cls
pic1.Height = pic1.Width
pic1.BackColor = vbBlack
pic1.AutoRedraw = True
pic1.Scale (-200, 200)-(200, -200)
pic1.ForeColor = vbGreen
pic1.DrawWidth = 1
pic1.Line (-200, 0)-(200, 0)
pic1.Line (190, 10)-(200, 0)
pic1.Line (190, -10)-(200, 0)
pic1.Line (0, -200)-(0, 200)
pic1.Line (10, 190)-(0, 200)
pic1.Line (-10, 190)-(0, 200)
End Sub
Private Sub Command1_Click()
Dim pA As POINT
Dim pB As POINT
Dim bc As Single
Dim bac As Single
Dim pt() As POINT
Dim r As Single
Dim n As Integer
Dim i As Integer
Dim result() As Single
Call DrawAxes
'//:测试
pA.x = 0
pA.y = 0
pB.x = 2
pB.y = 0
Debug.Print GetPoint(pA, 2, pB, 2, pt())
Debug.Print pt(0).x, pt(0).y
Debug.Print pt(1).x, pt(1).y
'Exit Sub
pA.x = txtAx.Text
pA.y = txtAy.Text
pB.x = txtBx.Text
pB.y = txtBy.Text
bc = txtBC.Text
bac = txtBAC.Text
pic1.ForeColor = vbRed
pic1.DrawWidth = 1
pic1.POINT pA.x, pA.y
pic1.POINT pB.x, pB.y
pic1.Line (pA.x, pA.y)-(pB.x, pB.y)
r = CalcAC(pA, pB, bc, bac)
'Label5.Caption = r
pic1.ForeColor = vbYellow
pic1.Circle (pA.x, pA.y), r
pic1.Circle (pB.x, pB.y), bc
n = GetPoint(pA, r, pB, bc, pt())
'Label5.Caption = Label5.Caption & "," & n
pic1.ForeColor = vbMagenta
For i = 0 To n - 1
pic1.POINT pt(i).x, pt(i).y
Debug.Print pt(i).x, pt(i).y
If (CalcDistance(pt(i), pB) - bc) < 0.0000001 Then
pic1.Line (pt(i).x, pt(i).y)-(pB.x, pB.y)
pic1.Line (pt(i).x, pt(i).y)-(pA.x, pA.y)
Label5.Caption = pt(i).x & "," & pt(i).y
'Exit For
Else
Debug.Print "--------", bc, CalcDistance(pt(i), pB)
End If
Next
pic1.ForeColor = vbGreen
If n = 2 Then
pic1.Line (pt(0).x, pt(0).y)-(pt(1).x, pt(1).y)
End If
End Sub
Private Sub Form_Load()
Call DrawAxes
End Sub
Private Function GetPoint(ByRef pA As POINT, ByVal ra As Single, ByRef pB As POINT, ByVal rb As Single, ByRef pt() As POINT) As Long
'//! 获取两个圆的交点
'//! 返回值:交点的个数;交点的坐标通过pt()数组引用返回
'//! 参数:pa,pb两个圆的圆心坐标,ra,rb两个圆的半径
Dim ab As Single
Dim n As Integer
Dim r As Integer
Dim result() As Single
Dim a As Single
Dim b As Single
Dim c As Single
Dim i As Integer
ab = CalcDistance(pA, pB)
If ab > (ra + rb) Or ab < Abs(ra - rb) Then
n = 0
ElseIf (ab < (ra + rb) And ab > Abs(ra - rb)) Then
n = 2
ElseIf (ab = Abs(ra - rb) Or ab = (ra + rb)) Then
n = 1
End If
Dim t As Single
t = ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.y ^ 2
a = 1 + ((pB.y - pA.y) / (pB.x - pA.x)) ^ 2
b = -1 * (2 * ((pB.y - pA.y) / (pB.x - pA.x)) * ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) + 2 * pA.y)
c = ((t - (2 * pB.x - 2 * pA.x) * pA.x) / (2 * pB.x - 2 * pA.x)) ^ 2 + pA.y ^ 2 - ra ^ 2
r = CalcFangCheng(a, b, c, result())
Debug.Assert r = n
If r > 0 Then
ReDim pt(r - 1) As POINT
For i = 0 To r - 1
pt(i).y = result(i)
pt(i).x = ((ra ^ 2 - rb ^ 2 + pB.x ^ 2 - pA.x ^ 2 + pB.y ^ 2 - pA.x ^ 2) - (2 * pB.y - 2 * pA.y) * pt(i).y) / (2 * pB.x - 2 * pA.x)
Next
End If
GetPoint = n
End Function
Private Function CalcDistance(ByRef pA As POINT, ByRef pB As POINT) As Single
'//! 计算平面内两点的距离
CalcDistance = Sqr((pB.x - pA.x) ^ 2 + (pB.y - pA.y) ^ 2)
End Function
Private Function CalcFangCheng(ByVal a As Single, ByVal b As Single, ByVal c As Single, ByRef result() As Single) As Long
'//! 解方程ax^2 + bx + c = 0
Dim n As Integer
Dim delta As Single
delta = b ^ 2 - 4 * a * c
If delta < 0 Then
n = 0
ElseIf delta > 0 Then
n = 2
ReDim result(1) As Single
result(0) = (b * (-1) + Sqr(delta)) / (2 * a)
result(1) = (b * (-1) - Sqr(delta)) / (2 * a)
Else
n = 1
ReDim result(0) As Single
result(0) = b * (-1) / (2 * a)
End If
CalcFangCheng = n
End Function
[/code]
[em1][em1][em1][em1]