tools.cls

坐标转换程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Tools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Public Function CaculateAzimuth(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double) As Double
    '计算方位角的函数
    Dim DX12 As Double
    Dim DY12 As Double
    DX12 = X2 - X1
    DY12 = Y2 - Y1
    On DX12 = 0 GoTo 11
       A = Atn(Abs(DY12) / Abs(DX12))
    If DY12 = 0 And DX12 > 0 Then
           CaculateAzimuth = PI / 2
        ElseIf DY12 = 0 And DX12 < 0 Then
           CaculateAzimuth = PI
        ElseIf DY12 > 0 And DX12 > 0 Then
           CaculateAzimuth = A
        ElseIf DY12 > 0 And DX12 < 0 Then
           CaculateAzimuth = PI - A
        ElseIf DY12 < 0 And DX12 < 0 Then
           CaculateAzimuth = A + PI
        ElseIf DY12 < 0 And DX12 > 0 Then
           CaculateAzimuth = 2 * PI - A
    End If
11:
    If DY12 > 0 And DX12 = 0 Then
           CaculateAzimuth = 0
        ElseIf DY12 > 0 And DX12 = 0 Then
           CaculateAzimuth = PI
    End If
End Function

Public Sub DegreeToH(Dgree As Double)
   '将测量中常用的角度转换为计算机用的弧度
   Dim Du As Integer
   Dim Fen As Integer
   Dim Miao As Single
   Dim Length As Integer
   Dim DegreeToH As Double
   Length = Len(Degree)
   If Degree >= 100 Then
      Du = Left(Degree, 3)
      Fen = Mid(Degree, 5, 2)
      If Length >= 9 Then
        Miao = Mid(Degree, 7) / (10 * (Length - 8))
      Else
        Miao = Mid(Degree, 7)
      End If
   Else
      Du = Left(Degree, 3)
      Fen = Mid(Degree, 4, 2)
      If Length >= 8 Then
        Miao = Mid(Degree, 6) / (10 * (Length - 7))
      Else
        Miao = Mid(Degree, 6)
      End If
   End If
       DegreeToH = Du + Fen / 60 + (Miao / 100) / 36
End Sub