Option Explicit
Sub abc()
Dim a, b, c, i, x, y
Dim p1(1 To 3, 1 To 3) '垂线点坐标及斜率
Dim p2(1 To 3, 1 To 2) '三角形顶点坐标
a = [a1:c3].Value
For i = 1 To 3 '转换为标准坐标系
If InStr(UCase(a(i, 2)), "SE") Then
a(i, 2) = 270 + Val(a(i, 2))
ElseIf InStr(UCase(a(i, 2)), "SW") Then
a(i, 2) = 270 - Val(a(i, 2))
Else
MsgBox "!": Exit Sub
End If
Next
For i = 1 To 3 '获取垂线点坐标
If a(i, 2) Mod 90 = 0 Then '边为水平或垂直线
'Select Case a(i, 2)
'Case 0
' p1(i, 1) = a(i, 3): p1(i, 2) = 0
'Case 90
' p1(i, 1) = 0: p1(i, 2) = a(i, 3)
'Case 180
' p1(i, 1) = -a(i, 3): p1(i, 2) = 0
'Case 270
' p1(i, 1) = 0: p1(i, 2) = -a(i, 3)
'End Select
Else
x = Abs(Cos(a(i, 2) * 3.1415926 / 180) * a(i, 3))
y = Abs(Sin(a(i, 2) * 3.1415926 / 180) * a(i, 3))
p1(i, 3) = -1 / Tan((a(i, 2)) * 3.1415926 / 180)
Select Case a(i, 2)
Case 0 To 90
If a(i, 3) > 0 Then
p1(i, 1) = x: p1(i, 2) = y
Else
p1(i, 1) = -x: p1(i, 2) = -y
End If
Case 90 To 180
If a(i, 3) > 0 Then
p1(i, 1) = -x: p1(i, 2) = y
Else
p1(i, 1) = x: p1(i, 2) = -y
End If
Case 180 To 270
If a(i, 3) > 0 Then
p1(i, 1) = -x: p1(i, 2) = -y
Else
p1(i, 1) = x: p1(i, 2) = y
End If
Case 270 To 360
If a(i, 3) > 0 Then
p1(i, 1) = x: p1(i, 2) = -y
Else
p1(i, 1) = -x: p1(i, 2) = y
End If
End Select
End If
Next
p2(1, 1) = (p1(1, 3) * p1(1, 1) - p1(1, 2) - p1(2, 3) * p1(2, 1) + p1(2, 2)) / (p1(1, 3) - p1(2, 3))
p2(1, 2) = p1(1, 3) * (p2(1, 1) - p1(1, 1)) + p1(1, 2)
p2(2, 1) = (p1(1, 3) * p1(1, 1) - p1(1, 2) - p1(3, 3) * p1(3, 1) + p1(3, 2)) / (p1(1, 3) - p1(3, 3))
p2(2, 2) = p1(1, 3) * (p2(2, 1) - p1(1, 1)) + p1(1, 2)
p2(3, 1) = (p1(2, 3) * p1(2, 1) - p1(2, 2) - p1(3, 3) * p1(3, 1) + p1(3, 2)) / (p1(2, 3) - p1(3, 3))
p2(3, 2) = p1(2, 3) * (p2(3, 1) - p1(2, 1)) + p1(2, 2)
[e1].Resize(3, 2) = p2
a = Sqr((p2(2, 2) - p2(3, 2)) ^ 2 + (p2(2, 1) - p2(3, 1)) ^ 2)
b = Sqr((p2(1, 2) - p2(3, 2)) ^ 2 + (p2(1, 1) - p2(3, 1)) ^ 2)
c = Sqr((p2(1, 2) - p2(2, 2)) ^ 2 + (p2(1, 1) - p2(2, 1)) ^ 2)
x = (p2(1, 1) * a + p2(2, 1) * b + p2(3, 1) * c) / (a + b + c)
y = (p2(1, 2) * a + p2(2, 2) * b + p2(3, 2) * c) / (a + b + c)
[h1] = Round(y, 5) & "," & Round(x, 5)
End Sub