mymodule1.bas

实现对导线测量数据的自动计算和导线图形的显示

Attribute VB_Name = "MyModule1"
Option Explicit

'度，分，秒的数据类型
Public Type gDMSForm
    Degree As Integer  '度
    Minute As Integer  '分
    Second As Integer  '秒
    Positive As Boolean '是否为正角
End Type

'Public gDMS(1 To 5) As gDMSForm

'导线测量后得到的各导线点的坐标
Public ResultX() As Double  '如何释放公共参数????
Public ResultY() As Double


'*************************
'新版：度，分，秒转化为弧度
'*************************
'DMS为输入的度分秒
Public Function DMSToRadian(ByVal DMS As Double) As Double

Dim strM As String
Dim strS As String

Dim intD As Integer
Dim intM As Integer
Dim intS As Integer

Dim strDMS As String 'DMS的字符格式
Dim ZeroNum As Integer

If DMS >= 0 Then
    strDMS = str(DMS)
Else
    strDMS = str(-DMS)
End If

If InStr(strDMS, ".") = 0 Then  '只含度
    DMSToRadian = DMS * 3.14159265358979 / 180
    Exit Function
Else
    ZeroNum = 4 - (Len(strDMS) - InStr(strDMS, "."))
End If

If ZeroNum < 0 Then
    DMS = Format(DMS, "#.####")
'    MsgBox "度分秒数据输入格式错误！", vbInformation, "警告"
'    Exit Function
End If

Select Case ZeroNum
Case 1
    strDMS = strDMS & "0"
Case 2
    strDMS = strDMS & "00"

Case 3
    strDMS = strDMS & "000"
End Select

strM = Mid(strDMS, Len(strDMS) - 3, 2)
strS = Mid(strDMS, Len(strDMS) - 1, 2)

intD = Int(strDMS)
intM = Int(strM)
intS = Int(strS)

If DMS >= 0 Then
    DMSToRadian = (intD + intM / 60 + intS / 3600) * 3.14159265358979 / 180
Else
    DMSToRadian = -(intD + intM / 60 + intS / 3600) * 3.14159265358979 / 180
End If

End Function

'新版：度，分，秒转化为度(十进制)
Public Function DMSToDegree(ByVal DMS As Double) As Double
Dim strM As String
Dim strS As String

Dim intD As Integer
Dim intM As Integer
Dim intS As Integer

Dim strDMS As String 'DMS的字符格式
Dim ZeroNum As Integer

If DMS >= 0 Then
    strDMS = str(DMS)
Else
    strDMS = str(-DMS)
End If

If InStr(strDMS, ".") = 0 Then  '只含度
    DMSToDegree = DMS
    Exit Function
Else
    ZeroNum = 4 - (Len(strDMS) - InStr(strDMS, "."))
End If

If ZeroNum < 0 Then
    DMS = Format(DMS, "#.####")
End If

Select Case ZeroNum
Case 1
    strDMS = strDMS & "0"
Case 2
    strDMS = strDMS & "00"
Case 3
    strDMS = strDMS & "000"
End Select

strM = Mid(strDMS, Len(strDMS) - 3, 2)
strS = Mid(strDMS, Len(strDMS) - 1, 2)

intD = Int(strDMS)
intM = Int(strM)
intS = Int(strS)

If DMS >= 0 Then
    DMSToDegree = intD + intM / 60 + intS / 3600
Else
    DMSToDegree = -(intD + intM / 60 + intS / 3600)
End If

End Function

'度(十进制)转化为秒(十进制)
Public Function DegreeToSecond(ByVal Degree As Double) As Double
Dim a, b As Integer
Dim c As Double

Dim tempDegree As Double
'如果Degree是负值，则化成正值进行计算，最后再化为负值
If Degree >= 0 Then
    tempDegree = Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 60)
    c = Round(((tempDegree - a) * 60 - b) * 60)
    DegreeToSecond = c + b * 60 + a * 3600
Else
    tempDegree = -Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 60)
    c = Round(((tempDegree - a) * 60 - b) * 60)
    DegreeToSecond = -(c + b * 60 + a * 3600)

End If

End Function

'度(十进制)转化为度，分，秒
Public Function DegreeToDMS(ByVal Degree As Double) As Double
Dim a, b As Integer
Dim c As Double
Dim tempDegree As Double

If Degree >= 0 Then
    tempDegree = Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 60)
    c = Round(((tempDegree - a) * 60 - b) * 60)
    DegreeToDMS = a + b / 100 + c / 10000
Else
    tempDegree = -Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 60)
    c = Round(((tempDegree - a) * 60 - b) * 60)
    DegreeToDMS = -(a + b / 100 + c / 10000)
End If
End Function

'度分秒合写形式转化为度，分，秒分离形式
'比如把1.2534写为1,25,34
Public Function DMSToDMSSep(ByVal Degree As Double) As gDMSForm
Dim a, b As Integer
Dim c As Double
Dim tempDegree As Double

If Degree >= 0 Then
    tempDegree = Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 100)
    c = Round(((tempDegree - a) * 100 - b) * 100)  '四舍五入
    DMSToDMSSep.Degree = a
    DMSToDMSSep.Minute = b
    DMSToDMSSep.Second = c
    DMSToDMSSep.Positive = True
Else
    tempDegree = -Degree
    a = Int(tempDegree)
    b = Int((tempDegree - a) * 60)
    c = Round(((tempDegree - a) * 60 - b) * 60)
    DMSToDMSSep.Degree = a
    DMSToDMSSep.Minute = b
    DMSToDMSSep.Second = c
    DMSToDMSSep.Positive = False

End If
End Function

'****************
'坐标正算
'****************
'Dist两点间距离
'Azimuth坐标方位角(以度分秒来表示)
'IfKnowStart是否已知点为起点
'XKnow已知点的X坐标
'YKnow已知点的Y坐标
'XResult所求未知点的X坐标
'YResult所求未知点的Y坐标
Public Sub CoordinatePositive(ByVal dist As Double, ByVal Azimuth As Double, ByVal IfKnowStart As Boolean, _
                            ByVal XKnow As Double, ByVal YKnow As Double, ByRef XCal As Double, ByRef YCal As Double)

Dim DeltaX As Double
Dim DeltaY As Double
'Dim RadianAzimuth As Double
'RadianAzimuth = (Azimuth)
If Azimuth >= 0 And Azimuth <= 90 Then  '所求未知点在测量第一象限
    DeltaX = dist * Cos(DMSToRadian(Azimuth))
    DeltaY = dist * Sin(DMSToRadian(Azimuth))
ElseIf Azimuth > 90 And Azimuth <= 180 Then '所求未知点在测量第二象限
    DeltaX = -dist * Sin(DMSToRadian(Azimuth - 90))
    DeltaY = dist * Cos(DMSToRadian(Azimuth - 90))

ElseIf Azimuth > 180 And Azimuth <= 270 Then '所求未知点在测量第三象限
    DeltaX = -dist * Cos(DMSToRadian(Azimuth - 180))
    DeltaY = -dist * Sin(DMSToRadian(Azimuth - 180))
    
ElseIf Azimuth > 270 And Azimuth <= 360 Then '所求未知点在测量第四象限
    DeltaX = dist * Sin(DMSToRadian(Azimuth - 270))
    DeltaY = -dist * Cos(DMSToRadian(Azimuth - 270))

End If

If IfKnowStart = True Then '已知点为起始点
    XCal = XKnow + DeltaX
    YCal = YKnow + DeltaY
Else '已知点为终止点
     XCal = XKnow - DeltaX
     YCal = YKnow - DeltaY
End If

End Sub

'****************
'坐标反算
'****************
'Dist两点间距离
'Azimuth坐标方位角(以度分秒来表示)
'IfKnowStart是否已知点为起点
'XKnow已知点的X坐标
'YKnow已知点的Y坐标
'XResult所求未知点的X坐标
'YResult所求未知点的Y坐标
Public Sub CoordinateNegative(ByRef dist As Double, ByRef Azimuth As Double, _
                            ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double)

Dim DeltaX As Double
Dim DeltaY As Double
Dim Angle As Double

DeltaX = X2 - X1
DeltaY = Y2 - Y1

dist = Sqr(DeltaX * DeltaX + DeltaY * DeltaY)
If DeltaX = 0 And DeltaY > 0 Then Azimuth = 90
If DeltaX = 0 And DeltaY < 0 Then Azimuth = 270
If DeltaX > 0 And DeltaY = 0 Then Azimuth = 0
If DeltaX < 0 And DeltaY = 0 Then Azimuth = 180

If DeltaX > 0 And DeltaY > 0 Then '所求方位角在测量第一象限
    Angle = Atn(DeltaY / DeltaX) * 180 / 3.14159265358979
    Azimuth = DegreeToDMS(Angle)
ElseIf DeltaX < 0 And DeltaY > 0 Then '所求方位角在测量第二象限
    Angle = Atn(Abs(DeltaX) / DeltaY) * 180 / 3.14159265358979
    Azimuth = DegreeToDMS(Angle) + 90
ElseIf DeltaX < 0 And DeltaY < 0 Then '所求方位角在测量第三象限
    Angle = Atn(DeltaY / DeltaX) * 180 / 3.14159265358979
    Azimuth = DegreeToDMS(Angle) + 180
ElseIf DeltaX > 0 And DeltaY < 0 Then '所求方位角在测量第四象限
    Angle = Atn(DeltaX / Abs(DeltaY)) * 180 / 3.14159265358979
    Azimuth = DegreeToDMS(Angle) + 270
End If

End Sub