calc.bas

该程序是三角网平差程序

Attribute VB_Name = "Calc"
Dim i, J, k, l As Integer
Dim zt, zt1 As String
Dim dij As Double
Dim dji As Double
Dim dik As Double
Dim dki As Double
Dim djk As Double
Dim dkj As Double


'度，分，秒转化为弧度
'Sub GETRAD(DMS As Double)
'Dim a As Integer
'Dim b, c As Double
'    For i = 1 To g_Obsnum
''        SDMS = Str(g_Dir(i))
'        a = Int(DMS)
'        b = Int((DMS - a) * 100) / 60#
'        c = (100 * DMS - Int(100 * DMS)) * 100 / 3600#
'        DMS = (a + b + c) * PI / 180#
'    Next i
'
'End Sub

Sub TrangleClosureError()
   For i = 1 To g_Obsnum
       
        a = Int(g_Dir(i))
        b = Int((g_Dir(i) - a) * 100) / 60#
        c = (100 * g_Dir(i) - Int(100 * g_Dir(i))) * 100 / 3600#
        g_Dir(i) = (a + b + c) * PI / 180#
       
       
   Next i
    zt = 0
    For i = 1 To g_Potnum - 2
        For J = i + 1 To g_Potnum - 1
            For k = J + 1 To g_Potnum
                zt1 = 0
                For l = 1 To g_Obsnum
                    If g_StaPotname(l) = g_PotName(i) And g_EndPotname(l) = g_PotName(J) Then
                       zt1 = zt1 + 1
                       dij = Str(g_Dir(l))
                    End If
                    If g_StaPotname(l) = g_PotName(J) And g_EndPotname(l) = g_PotName(i) Then
                       zt1 = zt1 + 1
                       dji = Str(g_Dir(l))
                    End If
                    If g_StaPotname(l) = g_PotName(i) And g_EndPotname(l) = g_PotName(k) Then
                       zt1 = zt1 + 1
                       dik = Str(g_Dir(l))
                    End If
                    If g_StaPotname(l) = g_PotName(k) And g_EndPotname(l) = g_PotName(i) Then
                       zt1 = zt1 + 1
                       dki = Str(g_Dir(l))
                    End If
                    If g_StaPotname(l) = g_PotName(J) And g_EndPotname(l) = g_PotName(k) Then
                       zt1 = zt1 + 1
                       djk = Str(g_Dir(l))
                    End If
                    If g_StaPotname(l) = g_PotName(k) And g_EndPotname(l) = g_PotName(J) Then
                       zt1 = zt1 + 1
                       dkj = Str(g_Dir(l))
                    End If
                Next l
                Call sjx
            Next k
        Next J
    Next i
'//平差
    t = 0
    For i = 1 To zt
       t = t + g_W(i) * g_W(i)
       
    Next i
    g_md = Sqr(t / zt / 6)
    
    
    
    
    
    Set arecord = g_d_Base.OpenRecordset("基本信息表", dbOpenTable)
    With arecord
         .Move First
         .Edit
         .Fields(10) = g_md
         .Update
         .Close
   End With

   Set arecord = g_d_Base.OpenRecordset("三角形闭合差 ", dbOpenTable)
        With arecord
            ic = .RecordCount
            If .RecordCount > 0 Then
               .MoveFirst
              For i = 1 To ic
                   .Delete
                   If i < ic Then
                      .MoveFirst
                  End If
              Next i
            End If
            For i = 1 To zt
                .AddNew
                .Fields(0) = i
                If g_PotName1(i) <> "" Then .Fields(1) = g_PotName1(i)
                If g_PotName2(i) <> "" Then .Fields(2) = g_PotName2(i)
                If g_PotName3(i) <> "" Then .Fields(3) = g_PotName3(i)
                .Fields(4) = g_W(i)
                .Update
               Next i
            .Close
        End With
  
End Sub
Sub sjx()

      If zt1 = 6 Then
                    zt = zt + 1
                    g_PotName1(zt) = g_PotName(i)
                    g_PotName2(zt) = g_PotName(J)
                    g_PotName3(zt) = g_PotName(k)
                    dijk = dji - djk
                    djik = dij - dik
                    dikj = dkj - dki
                    If dijk < 0.000000000001 Then dijk = Abs(dijk)
                 
                    If djik < 0.000000000001 Then djik = Abs(djik)
                    
                    If dikj < 0.000000000001 Then dikj = Abs(dikj)
             
                    If dijk > PI Then
                       dijk = 2 * PI - dijk
                      End If
                    If djik > PI Then
                       djik = 2 * PI - djik
                       End If
                    If dikj > PI Then
                       dikj = 2 * PI - dikj
                     End If
                    
                    g_W(zt) = Str(dijk + djik + dikj - PI) * g_P
                   
                  
     End If
End Sub