frmbihecha.frm

一个附和导线的严密计算平差程序

VERSION 5.00
Begin VB.Form frmBihecha 
   Caption         =   "闭合差计算"
   ClientHeight    =   4095
   ClientLeft      =   3660
   ClientTop       =   3255
   ClientWidth     =   6735
   LinkTopic       =   "Form1"
   ScaleHeight     =   4095
   ScaleWidth      =   6735
   Begin VB.CommandButton Command3 
      Caption         =   "边长粗差探测"
      Height          =   495
      Left            =   3720
      TabIndex        =   14
      Top             =   3120
      Width           =   1695
   End
   Begin VB.CommandButton cmdBianchangScan 
      Caption         =   "边长粗差探测"
      Height          =   495
      Left            =   720
      TabIndex        =   13
      Top             =   3120
      Width           =   1695
   End
   Begin VB.TextBox Text6 
      Height          =   375
      Left            =   5400
      TabIndex        =   12
      Text            =   "1/2000"
      Top             =   2280
      Width           =   1215
   End
   Begin VB.TextBox Text5 
      Height          =   375
      Left            =   2760
      TabIndex        =   11
      Text            =   "1/2000"
      Top             =   2280
      Width           =   1815
   End
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   360
      TabIndex        =   10
      Text            =   "1/2000"
      Top             =   2280
      Width           =   1935
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   2400
      TabIndex        =   6
      Text            =   "1/2000"
      Top             =   1560
      Width           =   1935
   End
   Begin VB.CommandButton Command2 
      Caption         =   "坐标增量闭合差"
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   1455
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   4560
      TabIndex        =   2
      Text            =   "0"
      Top             =   480
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Text            =   "0"
      Top             =   480
      Width           =   1935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "角度闭合差"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
   Begin VB.Label Label5 
      Caption         =   "闭合差："
      Height          =   375
      Left            =   4680
      TabIndex        =   9
      Top             =   2400
      Width           =   735
   End
   Begin VB.Label Label4 
      Caption         =   "FY："
      Height          =   375
      Left            =   2400
      TabIndex        =   8
      Top             =   2400
      Width           =   495
   End
   Begin VB.Label Label3 
      Caption         =   "FX："
      Height          =   375
      Left            =   0
      TabIndex        =   7
      Top             =   2400
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "限差："
      Height          =   375
      Left            =   1680
      TabIndex        =   5
      Top             =   1560
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "限差："
      Height          =   375
      Left            =   3840
      TabIndex        =   3
      Top             =   600
      Width           =   615
   End
End
Attribute VB_Name = "frmBihecha"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBianchangScan_Click()
    Dim FA(1 To 100) As Double
        
    For i = 1 To IntCount '方位角计算
        If i = 1 Then
            If DFMDu(aa(1)) >= 180 Then
                FA(i) = DFMDu(aa(1)) - 360 + DFMDu(InputDat(i).Guancejiao)
            Else
                FA(i) = DFMDu(aa(1)) + DFMDu(InputDat(i).Guancejiao)
            End If
            If FA(i) >= 360 Then
                FA(i) = FA(i) - 360
            ElseIf FA(i) < 0 Then
                FA(i) = FA(i) + 360
            End If
        Else
            FA(i) = FA(i - 1) - 180 + DFMDu(InputDat(i).Guancejiao)
            If FA(i) >= 360 Then
                FA(i) = FA(i) - 360
            ElseIf FA(i) < 0 Then
                FA(i) = FA(i) + 360
            End If
        End If
    Next i
    
    Dim Zxx(1 To 100) As Double
    Dim Zyy(1 To 100) As Double
    Dim ChaXY(1 To 100) As Double
    Dim Zx As Double
    Dim Zy As Double
       
    For i = 1 To IntCount - 1 '坐标增量闭合差计算
        Zxx(i) = InputDat(i).Bianchang * Cos(DuHudu(FA(i)))
        Zyy(i) = InputDat(i).Bianchang * Sin(DuHudu(FA(i)))
        Zx = Zx + Zxx(i)
        Zy = Zy + Zyy(i)
    Next
    
    Zx = Zx - (xx(2) - xx(1))
    Zy = Zy - (yy(2) - yy(1))
    
    For i = 1 To IntCount - 1
        If Zy = 0 Then
            Zy = 0.000001
        End If
        If Zyy(i) = 0 Then
            Zyy(i) = 0.000001
        End If
        ChaXY(i) = Abs(Zx / Zy - Zxx(i) / Zyy(i))
    Next
    
    Dim w As Double
    Dim Jilu As Integer
    
    w = ChaXY(1)
    
    For i = 1 To IntCount - 1
        If ChaXY(i) <= w Then
            w = ChaXY(i)
            Jilu = i
        End If
    Next
    
    MsgBox "粗差大概发生在第" + str(Jilu) + "条边；边长粗差值大概为：" + str(Sqr(Zx * Zx + Zy * Zy))
    
    
End Sub

Private Sub Command1_Click()
    Dim jiaoduHe As Double
    Dim biheCha As Double
    Text2.Text = str(40 * Sqr(IntCount))
    
    For i = 1 To IntCount
        jiaoduHe = jiaoduHe + DFMDu(InputDat(i).Guancejiao)
    Next
    
    If DFMDu(aa(1)) >= 180 Then
      biheCha = DFMDu(aa(1)) - (IntCount + 1) * 180 + jiaoduHe - DFMDu(aa(2))
    Else
      biheCha = DFMDu(aa(1)) - (IntCount - 1) * 180 + jiaoduHe - DFMDu(aa(2))
    End If
    Text1.Text = str(biheCha * 3600)
    
End Sub

Private Sub Command2_Click()
    Dim FA(1 To 100) As Double
        
    For i = 1 To IntCount '方位角计算
        If i = 1 Then
            If DFMDu(aa(1)) >= 180 Then
                FA(i) = DFMDu(aa(1)) - 360 + DFMDu(InputDat(i).Guancejiao)
            Else
                FA(i) = DFMDu(aa(1)) + DFMDu(InputDat(i).Guancejiao)
            End If
            If FA(i) >= 360 Then
                FA(i) = FA(i) - 360
            ElseIf FA(i) < 0 Then
                FA(i) = FA(i) + 360
            End If
        Else
            FA(i) = FA(i - 1) - 180 + DFMDu(InputDat(i).Guancejiao)
            If FA(i) >= 360 Then
                FA(i) = FA(i) - 360
            ElseIf FA(i) < 0 Then
                FA(i) = FA(i) + 360
            End If
        End If
    Next i
    
    Dim Zx As Double
    Dim Zy As Double
    Dim LongXY As Double
    Dim Fxy As Double
    
    For i = 1 To IntCount - 1 '坐标增量闭合差计算
        Zx = Zx + InputDat(i).Bianchang * Cos(DuHudu(FA(i)))
        Zy = Zy + InputDat(i).Bianchang * Sin(DuHudu(FA(i)))
        LongXY = LongXY + InputDat(i).Bianchang
    Next
    Zx = Zx - (xx(2) - xx(1))
    Zy = Zy - (yy(2) - yy(1))
    
    Fxy = Sqr(Zx * Zx + Zy * Zy)
    
    Text4.Text = str(Zx)
    Text5.Text = str(Zy)
    
    If Fxy <> 0 Then
        Text6.Text = "1/" + str(Int(LongXY / Fxy))
    Else
        Text6.Text = "计算相当精确"
    End If
End Sub