frmsinglelevel.vb

水准网的简单计算,用vb.net编写的,可读取文件

Public Class frmSingleLevel

    Private Sub btnCompute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCompute.Click
        Dim hObs() As Double '高差观测值
        Dim dObs() As Double '水准路线长度
        Dim Ha, Hb As Double '已知点高程
        Dim LevelType As Short '单一水准类型
        Dim strAllInput As String '观测数据
        Dim strLines() As String '字符串数组，一个元素表示一行
        Dim nObsCount As Short '观测值个数
        Dim strTmp() As String '字符串数组

        'strAllInput = txtInput.Text '获得输入数据
        'strLines = Split(strAllInput, Chr(13) & Chr(10)) '按行分离输入数据

        'If UBound(strLines) = 0 Then '输入数据为空
        '    MsgBox("请输入数据")
        'End If


        LevelType = Val(strLines(0)) '第一行为单一水准类型
        If LevelType = 1 Then '附合水准
            strTmp = Split(strLines(1), ",")
            Ha = Val(strTmp(1)) '获取起始点高程
            strTmp = Split(strLines(2), ",")
            Hb = Val(strTmp(1)) '获取终点高程
            nObsCount = strLines.GetLength(0) - 3 '获得观测值个数
        Else
            strTmp = Split(strLines(1), ",")
            Ha = Val(strTmp(1))
            Hb = Ha '闭合水准可看成起点和终点为同一点的附合水准
            nObsCount = strLines.GetLength(0) - 2
        End If
        ReDim hObs(nObsCount) '根据实际个数调整观测数据数组的大小
        ReDim dObs(nObsCount)

        Dim i As Integer
        '逐行用Split函数分离，获取观测数据
        For i = 0 To nObsCount - 1
            If LevelType = 0 Then
                strTmp = Split(strLines(i + 2), ",")
            Else
                strTmp = Split(strLines(i + 3), ",")
            End If
            hObs(i) = Val(strTmp(1))
            dObs(i) = Val(strTmp(2))
        Next i
        Dim dblFh, dblSumD As Double
        dblFh = 0
        dblSumD = 0
        For i = 0 To nObsCount - 1
            dblFh = dblFh + hObs(i) '计算高差闭合差
            dblSumD = dblSumD + dObs(i) '计算水准路线总长度
        Next i
        dblFh = dblFh - (Hb - Ha) '计算高差闭合差

        For i = 0 To nObsCount - 1 '按路线长度分配闭合差
            hObs(i) = hObs(i) - dblFh * dObs(i) / dblSumD
        Next i

        Dim dblH() As Double
        ReDim dblH(nObsCount)

        '推算未知点高程
        dblH(0) = Ha + hObs(0)
        For i = 0 To nObsCount - 2
            dblH(i + 1) = dblH(i) + hObs(i + 1)
        Next i

        '输出结果
        Dim strOutput As String
        strOutput = "闭合差：" & Format(dblFh * 1000, "####.0") & " mm" & Chr(13) & Chr(10) _
                  & "水准路线总长度：" & Str(dblSumD) & " km" & Chr(13) & Chr(10) _
                  & "每公里高差改正数：" & Format(dblFh / dblSumD * 1000, "####.0") & " mm" & Chr(13) & Chr(10) & Chr(13) & Chr(10) _
                  & "序号   " & "改正后h   " & "调整后H (m) " & Chr(13) & Chr(10)
        For i = 0 To nObsCount - 1
            strOutput = strOutput & Str(i + 1) & Chr(9) & Str(hObs(i)) & Chr(9) & Str(dblH(i)) & Chr(13) & Chr(10)
        Next i

        txtResult.Text = strOutput

    End Sub

    Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
        txtInput.Text = ""
        txtResult.Text = ""
    End Sub

    
    Private Sub frmSingleLevel_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        '数据格式：
        '第一行：单水准类型，1=附合，0=闭合
        '第二行：起点高程,"点号，高程"
        '第三行：终点高程，"点号，高程"（附合水准才有，闭合水准则开始观测数据）
        '第四行：观测数据，"序号，高差观测值m，水准路线长度km"
        '......
        txtInput.Text = "1" & Chr(13) & Chr(10) _
                        & "A, 45.286" & Chr(13) & Chr(10) _
                        & "B, 49.579" & Chr(13) & Chr(10) _
                        & "1,2.331,1.6" & Chr(13) & Chr(10) _
                        & "2,2.813,2.1" & Chr(13) & Chr(10) _
                        & "3,-2.244,1.7" & Chr(13) & Chr(10) _
                        & "4,1.430,2.0"
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim hObs() As Double '高差观测值
        Dim dObs() As Double '水准路线长度
        Dim Ha, Hb As Double '已知点高程
        Dim LevelType As Short '单一水准类型
        Dim strAllInput As String '观测数据
        Dim strLines() As String '字符串数组，一个元素表示一行
        Dim nObsCount As Short '观测值个数
        Dim strTmp() As String '字符串数组

        'strAllInput = txtInput.Text '获得输入数据
        'strLines = Split(strAllInput, Chr(13) & Chr(10)) '按行分离输入数据

        'If UBound(strLines) = 0 Then '输入数据为空
        '    MsgBox("请输入数据")
        'End If
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.Cancel Then
            Exit Sub
        End If

        Dim strFileName As String
        Dim strLine As String
        strFileName = OpenFileDialog1.FileName
        FileOpen(1, strFileName, OpenMode.Input)
        strLine = LineInput(1)
        LevelType = Val(strLine) '第一行为单一水准类型

        If LevelType = 1 Then '附合水准
            strLine = LineInput(1)
            strTmp = Split(strLine, ",")
            Ha = Val(strTmp(1)) '获取起始点高程
            strLine = LineInput(1)
            strTmp = Split(strLine, ",")

            Hb = Val(strTmp(1)) '获取终点高程
            ' nObsCount = strLines.GetLength(0) - 3 '获得观测值个数
        Else
            strLine = LineInput(1)
            strTmp = Split(strLine, ",")
            Ha = Val(strTmp(1))
            Hb = Ha '闭合水准可看成起点和终点为同一点的附合水准
            '  nObsCount = strLines.GetLength(0) - 2
        End If
        nObsCount = 0
        Do While Not EOF(1)
            strLine = LineInput(1)
            nObsCount = nObsCount + 1
            ReDim Preserve hObs(nObsCount - 1) '根据实际个数调整观测数据数组的大小
            ReDim Preserve dObs(nObsCount - 1)

            strTmp = Split(strLine, ",")
            hObs(nObsCount - 1) = Val(strTmp(1))
            dObs(nObsCount - 1) = Val(strTmp(2))
        Loop
        FileClose(1)
     

        Dim i As Integer
        
        Dim dblFh, dblSumD As Double
        dblFh = 0
        dblSumD = 0
        For i = 0 To nObsCount - 1
            dblFh = dblFh + hObs(i) '计算高差闭合差
            dblSumD = dblSumD + dObs(i) '计算水准路线总长度
        Next i
        dblFh = dblFh - (Hb - Ha) '计算高差闭合差

        For i = 0 To nObsCount - 1 '按路线长度分配闭合差
            hObs(i) = hObs(i) - dblFh * dObs(i) / dblSumD
        Next i

        Dim dblH() As Double
        ReDim dblH(nObsCount)

        '推算未知点高程
        dblH(0) = Ha + hObs(0)
        For i = 0 To nObsCount - 2
            dblH(i + 1) = dblH(i) + hObs(i + 1)
        Next i

        '输出结果
        Dim strOutput As String
        strOutput = "闭合差：" & Format(dblFh * 1000, "####.0") & " mm" & Chr(13) & Chr(10) _
                  & "水准路线总长度：" & Str(dblSumD) & " km" & Chr(13) & Chr(10) _
                  & "每公里高差改正数：" & Format(dblFh / dblSumD * 1000, "####.0") & " mm" & Chr(13) & Chr(10) & Chr(13) & Chr(10) _
                  & "序号   " & "改正后h   " & "调整后H (m) " & Chr(13) & Chr(10)
        For i = 0 To nObsCount - 1
            strOutput = strOutput & Str(i + 1) & Chr(9) & Str(hObs(i)) & Chr(9) & Str(dblH(i)) & Chr(13) & Chr(10)
        Next i

        txtResult.Text = strOutput

        SaveFileDialog1.DefaultExt = "txt"
        If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.Cancel Then
            Exit Sub
        End If
        strFileName = SaveFileDialog1.FileName
        FileOpen(1, strFileName, OpenMode.Output)
        PrintLine(1, "闭合差：" & Format(dblFh * 1000, "####.0") & " mm")
        PrintLine(1, "水准路线总长度：" & Str(dblSumD) & " km")
        PrintLine(1, "每公里高差改正数：" & Format(dblFh / dblSumD * 1000, "####.0") & " mm")
        PrintLine(1)
        PrintLine(1, "序号   " & "改正后h   " & "调整后H (m) ")
        For i = 0 To nObsCount - 1
            PrintLine(1, Str(i + 1) & Chr(9) & Str(hObs(i)) & Chr(9) & Str(dblH(i)))
        Next i

        FileClose(1)
    End Sub
End Class