水准网平差.frm

采用vb程序语言编写

    
  Next i
  
End Sub
Public Sub Quanzhen() '构建权阵
  Dim n1 As Integer, n2 As Integer ' n为循环计数器
  If Option2.Value = True Then
     c = Val(Text5.Text)
   End If
For n1 = 1 To i1
 For n2 = 1 To i1
   If n1 <> n2 Then
     P(n1, n2) = 0
    Else
     P(n1, n2) = c / S1(n2)
    End If
 Next n2
Next n1
End Sub
Public Sub x() '求解x的函数
Dim cc As Integer
 Mchange i1, i2, Matrixchange, xishuB
 Mmultiply i2, i1, i1, i1, MatrixMultiply, Matrixchange, P
 Mmultiply i2, i1, i1, i2, MatrixMultiply1, MatrixMultiply, xishuB
 MRinv i2, MatrixMultiply1
 Mmultiply i2, i2, i2, i1, MatrixMultiply2, MatrixMultiply1, Matrixchange
 Mmultiply i2, i1, i1, i1, MatrixMultiply3, MatrixMultiply2, P
 Mmultiply i2, i1, i1, 1, dqiuHv, MatrixMultiply3, L
 cc = 1
End Sub
Public Sub v() '求解观测值改正数的函数
' Dim aa As Integer
  Mmultiply i1, i2, i2, 1, MatrixMultiply4, xishuB, dqiuHv
  Mminus i1, 1, gchv, MatrixMultiply4, L
  Msum i1, 1, LL, L0, L
  Msum i2, 1, XX, X0, dqiuHv
  'aa = 1
End Sub


Private Sub Command3_Click()
' xshuB
'Quanzhen
End Sub

Private Sub Form_Load()
    Text1.Text = "": Text2.Text = "": Text3.Text = "": Text4.Text = ""
    Text5.Text = ""
    Option1.Value = True
    Option2.Enabled = True
End Sub

Private Sub Option1_Click()
 If Option1.Value = True Then
   Option2.Enabled = False
   'MsgBox "请在单位权观测数的文本框中输入站数！", vbOKCancel + vbDefaultButton1
 End If
End Sub

Private Sub Option2_Click()
 If Option2.Value = True Then
   Option1.Enabled = False
   MsgBox "请在单位权观测数的文本框中输入定权距离！", vbOKCancel + vbDefaultButton1
 End If
   
End Sub

Private Sub OriginalFile_Click()    '水准网观测平差数据输入
    Dim linedata As String 'linedata为存储每行的数据变量
   ' Dim lieMatrix(20) As String
  ' Dim lineMatrix1
  ' Dim lineMatrix2
  ' Dim lineMatrix3
  ' Dim lineMatrix4
  ' Dim i1 As Integer, i2 As Integer, i3 As Integer
   ' N1 = Val(Text1.Text)  'N1为已知高程点数
   ' N2 = Val(Text2.Text)  'N2为观测高差数
   ' N3 = Val(Text3.Text)  '待求点高程点数
  '  N4 = Val(Text4.Text)
    'ReDim hMatrix(N1) As Double
   ' ReDim gaochaMatrix(N2) As Double  '注意数组的界
   ' ReDim daiqiuMatrix(N3) As Double
    'ReDim ceduanMatrix(N4) As Double
    Dim kk As Integer, kkk As Integer, k4 As Integer  '循环计数器
    Dim k  'k()用来接收读取一行后用split（）
    
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "*.txt" And CommonDialog1.FileName = "" Then
    MsgBox "数据文件格式不对,请确认!", vbOKCancel + vbCritical + vbDefaultButton1
   'End If
   ' If CommonDialog1.FileName = "*.txt" Then
   ' Open CommonDialog1.FileName For Input As #1  '打开原始数据文件
   ' Do While Not EOF(1) '判断是否到了文件末尾
       ' Line Input #1, linedata
     'If linedata = "已知高程点：" Then
      ' Line Input #1, linedata
     '  Line Input #1, linedata
     ' lineMatrix1 = Split(linedata, ",,", -1, 1)
    ' ElseIf linedata = "观测高差Li(单位m)：" Then
        'Line Input #1, linedata
       ' Line Input #1, linedata
       ' lineMatrix2 = Split(linedata, ",,", -1, 1)
  '  ElseIf linedata = "各水准路线长度Si(单位km)：" Then
      ' Line Input #1, linedata
      ' Line Input #1, linedata
     '  lineMatrix3 = Split(linedata, ",,", -1, 1)
        
   ' ElseIf linedata = "待求水准点高程平差值：" Then
    '    Line Input #1, linedata
      ' lineMatrix4 = Split(linedata, ",,", -1, 1)
    
   'End If
  '  Loop
  '  Close #1
  '  For i1 = 0 To N1 - 1
   
   '   hMatrix(i1) = Val(lineMatrix1(i1))
   '  Next i1
   ' For i2 = 0 To N2 - 1
    '    gaochaMatrix(i2) = Val(lineMatrix2(i2))
  '  Next i2
  '  For i3 = 0 To N4 - 1
    '  ceduanMatrix(i3) = Val(lineMatrix3(i3))
   ' Next i3
'  Else
Else
  'If CommonDialog1.FileName = "*.txt" Then
   Open CommonDialog1.FileName For Input As #1
  ' Do While Not EOF(1)
   Line Input #1, linedata  'linedata用来存储一行的信息
    If linedata = "观测参数个数" Then
       Line Input #1, linedata
       i1 = Val(linedata)
       
    End If
   Line Input #1, linedata
   If linedata = "必要参数个数" Then
       Line Input #1, linedata
       i2 = Val(linedata)
   End If
   Line Input #1, linedata
   If linedata = "水准点总数" Then
    Line Input #1, linedata
    i3 = Val(linedata)
    
   End If
   ReDim a1(1 To i1)  '实际侧段数目，等于观测值个数
   ReDim a2(1 To i3)  'i3为水准点的个数，还没有定义
   ReDim S1(1 To i1)  '确定距离矩阵维数及大小
   ReDim P(1 To i1, 1 To i1)  '确定权阵地维数及大小
   ReDim Mchange(1 To i1, 1 To i1)
   ReDim MatrixMultiply(1 To i2, 1 To i1)
   ReDim MatrixMultiply1(1 To i2, 1 To i2)
   ReDim MatrixMultiply2(1 To i2, 1 To i1)
   ReDim MatrixMultiply3(1 To i2, 1 To i1)
   ReDim MatrixMultiply4(1 To i1)
   Dim ii As Integer
    ii = 1
  ' ReDim dqiuHv(1 To i2)
   ReDim gchv(1 To i1)
   ReDim LL(1 To i1, 1 To 1)
   ReDim XX(1 To i2, 1 To 1)
   ReDim xishuB(1 To i1, 1 To i2)
   ReDim L(1 To i1, 1 To 1)
   ReDim L0(1 To i1, 1 To 1)
   ReDim X0(1 To i2, 1 To 1)
   '动态定义数组的大小和维数
   Line Input #1, linedata
   For kk = 1 To i3
    Line Input #1, linedata
    k = Split(linedata, ",", -1, 1)
    a2(kk).ID = k(0)
    a2(kk).IDH = Val(k(1))
    
   If Mid(k(0), 1, 4) = "Para" Then
     X0(ii, 1) = Val(k(1))
     ii = ii + 1
   End If
   Next kk
   Line Input #1, linedata
   For kkk = 1 To i1
    Line Input #1, linedata
    k = Split(linedata, ",", -1, 1)
    L0(kkk, 1) = Val(k(1))
    a1(kkk).H = Val(k(1))
    a1(kkk).ID1.ID = k(2)
    a1(kkk).ID1.IDH = Val(k(3))
    a1(kkk).ID2.ID = k(4)
    a1(kkk).ID2.IDH = k(5)
   Next kkk
   Line Input #1, linedata
  For k4 = 1 To i1
    Line Input #1, linedata
    k = Split(linedata, ",", -1, 1)
    S1(k4) = k(1)
  Next k4
 '  Loop
' End If
  Close #1
  
  End If
 
    
End Sub
Private Sub Command1_Click()  '水准网平差计算
 Quanzhen
 xshuB
 x
 v
End Sub

Private Sub Command2_Click()
    End
    
End Sub


'*****************************************
'******************************************

'**********************************************************
'**********************************************************
'定义组成各矩阵的函数
Private Sub gouzao()

End Sub

Private Sub ResultFile_Click()  '数据输出或保存在*.txt中
 Dim outstring As String
 Dim k1 As Integer, k2 As Integer
 Dim k3 As Integer, k4 As Integer
 Dim k5 As Integer, k6 As Integer
 Dim k7 As Integer, k8 As Integer
 CommonDialog1.ShowSave
 If CommonDialog1.FileName <> "*.txt" And CommonDialog1.FileName <> "" Then
  Open CommonDialog1.FileName For Output As #2
   ' For i = 0 To List1.ListCount - 1
   ' dt = dt + List1.List(i)
  outstring = "解法方程结果为:" + vbCrLf
   
   For k2 = 1 To 1
    For k1 = 1 To i2
   
       
        outstring = outstring + "   " + Format(dqiuHv(k1, k2) * 1000, "######.0000") + "mm"
     Next k1
        outstring = outstring + vbCrLf
    Next k2
      outstring = outstring + vbCrLf
      outstring = outstring + vbCrLf + "观测值改正数的结果:"
      outstring = outstring + vbCrLf
     For k3 = 1 To 1
       For k4 = 1 To i1
        outstring = outstring + "   " + Format(gchv(k4, k3) * 1000, "######.0000") + "mm"
       Next k4
       
       Next k3
        outstring = outstring + vbCrLf
        outstring = outstring + vbCrLf
      outstring = outstring + vbCrLf + "观测值平差结果:"
      outstring = outstring + vbCrLf
     For k6 = 1 To 1
       For k5 = 1 To i1
        outstring = outstring + "   " + Format(LL(k5, k6), "######.0000") + "m"
       Next k5
       
       Next k6
        outstring = outstring + vbCrLf
      outstring = outstring + vbCrLf
      outstring = outstring + vbCrLf + "高程点高程平差结果:"
      outstring = outstring + vbCrLf
     For k7 = 1 To 1
       For k8 = 1 To i2
        outstring = outstring + "   " + Format(XX(k8, k7), "######.0000") + "m"
       Next k8
       
       Next k7
  Print #2, outstring
  Close #2
  
 End If

End Sub