tools.bas

坐标转换程序

Attribute VB_Name = "Tools"

'########################计算方位角的函数######### OK ################
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
    If DY12 > 0 And DX12 = 0 Then
        CaculateAzimuth = 0
    ElseIf DY12 < 0 And DX12 = 0 Then
        CaculateAzimuth = PI()
    End If
    If DX12 <> 0 Then
           a = Atn(Abs(DY12 / 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 = PI() + a
            ElseIf DY12 < 0 And DX12 > 0 Then
               CaculateAzimuth = 2 * PI - a
        End If
    End If
End Function

'********************将测量中常用的角度转换为计算机用的弧度**** OK ****************
Public Function DegreeToH(Degree As String) As Double
   Dim Du As Integer
   Dim Fen As Integer
   Dim Miao As Single
   Dim Length As Integer
   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) / (180 / PI())
End Function

'()()()()()()()()()()() 判断整桩 ()()()()()()() OK ()()()()()()()))()
Public Function Distiguish(B As Double, V As Integer) As Double
    Distiguish = B - (B Mod V)
End Function

'￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥￥确定输出格式￥￥￥￥￥￥￥￥￥￥￥
Public Sub OutPut(Xput, Yput, L_put As Double)
    Dim Text_MPut(3) As String
    ROW_OUT = ROW_OUT + 1          '
'       ROW_NO = ROW_NO + 1
    '输出的桩号计算
    If L_put <> (Val(Form2.Text1(3).Text) - Val(Form2.Text1(0).Text)) Then
        If Form2.Option1(0).Value = True Then
            L_put = Tools.Distiguish(Int(Val(Form2.Text1(0).Text)), Cac_D) + ROW_OUT * Cac_D
        ElseIf Form2.Option1(1).Value = True Then
            L_put = L_put + Val(Form2.Text1(0).Text)
        End If
    ElseIf L_put = Val(Form2.Text1(3).Text) - Val(Form2.Text1(0).Text) Then
       L_put = L_put + Val(Form2.Text1(0).Text)
    End If
      '将结果放入一个数组Text_Put(n)中
    Text_MPut(0) = ROW_OUT
    Text_MPut(1) = "K" & Int(L_put / 1000) & "+" & Format(L_put - (Int(L_put / 1000)) * 1000, "000.000") & Temp
    Text_MPut(2) = Xput: Text_MPut(3) = Yput
      ' 将结果输出
    Form2.MSHFlexGrid1.Rows = ROW_OUT + 1
    For h = o To 3
       '输出中桩坐标
       Form2.MSHFlexGrid1.Row = ROW_OUT ' 输出行
       Form2.MSHFlexGrid1.Col = h
       Form2.MSHFlexGrid1.Text = Text_MPut(h) '输出内容
    Next
End Sub

'计算结果存盘（txt）OK
Public Sub Save_Text(SN As Double)
  FileNO = FreeFile
  Open File_Path & "\中桩坐标-直线.txt" For Output As #FileNO
  Print #FileNO, String(30, "——")
  Print #FileNO, Tab(5); "工程名称："; Project_Name
  Print #FileNO, Tab(5); "计 算 者："; Caculaters
  Print #FileNO, Tab(5); "检 核 人："; Checkers
  Print #FileNO, String(30, "——")
  Print #FileNO, Tab(10); "中桩坐标列下："
  Print #FileNO, String(30, "——")
    For g = 0 To SN
        For j = 0 To 4
          Form2.MSHFlexGrid1.Row = g
          Form2.MSHFlexGrid1.Col = j
          Print #FileNO, Form2.MSHFlexGrid1.Text & Space(Len(SN) - Len(g));
        Next j
        Print #FileNO, Chr(10)
    Next g
    Print #FileNO, String(30, "——")
    If Form2.Check1.Value = 1 Then
       Print #FileNO, Tab(10); "边桩坐标列下："; Tab(25); "边桩距离："; Form2.Text3.Text; "m"
       Print #FileNO, String(30, "——")
       For g = 0 To SN * 2 + 1
        For j = 0 To 4
          Form2.MSHFlexGrid2.Row = g
          Form2.MSHFlexGrid2.Col = j
          Print #FileNO, Form2.MSHFlexGrid2.Text & Space(Len(Str(Val(SN) / 2)) - Len(g));
        Next j
        Print #FileNO, Chr(10)
        If g = SN Then
           Print #FileNO, String(30, "——")
        End If
    Next g
    Print #FileNO, String(30, "——")
    End If
    Print #FileNO, Tab(25); "计算时间："; Format(Date, "yyyy -mm -dd")
    Print #FileNO, String(30, "——")
  Close #FileNO
End Sub