四等水准附和导线、闭合导线平差VB代码

程序说明：数据录入文件的存储格式为：按每一测站的距离、高差形式存储，平差之前需要输入测站总数，依次点击“平差计算”、“成果分析”、“成果输出“。Dim ds() As Single, ht() As Single, detht() As Single, zh() As Single ht测量高差，deth高差改正数，zh点高程Dim fht As Single, n As Integer, fr As Single, sds As Single fht高差闭合差，n测站数，fr高差闭差合限差，sds线路总长Private Sub Command3_Click() EndEnd SubPrivate Sub Command5_Click() Dim i As Integer n = Val(Text3.Text) If n = 0 Then MsgBox 请输入测站数 Exit Sub End If ReDim ht(n) As Single, ds(n) As Single, detht(n) As Single, zh(n) As Single CD.Filter = 文本文件(*.txt)|*.txt|所有文件(*.*)|*.* CD.ShowOpen strfilename = CD.FileName Open strfilename For Input As #1 For i = 1 To n Input #1, ds(i), ht(i) If ds(i) 160 Then MsgBox 第 & i & 测站视距超限 Exit Sub End If Next i Close #1 MsgBox 数据已录入 End SubPrivate Sub Command6_Click() Dim i As Integer, sht As Single, x As Single Dim a As Single, b As Single sds = 0 sht = 0 For i = 1 To n sds = sds + ds(i) sht = sht + ht(i) Next i If Option1.Value Then a = Val(Text1.Text) b = Val(Text2.Text) fht = sht - (a - b) Else If Option2.Value Then a = Val(Text1.Text) fht = sht End If End If zh(0) = a For i = 1 To n x = -fht * ds(i) / sds detht(i) = x ht(i) = ht(i) + detht(i) zh(i) = zh(i - 1) + ht(i) Next i MsgBox 平差计算已完成 End SubPrivate Sub Command7_Click() Dim x As Single fr = 40 * Sqr(sds / 1000) x = Abs(fht) If x fr Then MsgBox 线路全长高差闭合差超限，但系统已按照平差原理平差，如需保存结果，请点击“成果保存”按钮 Exit Sub Else MsgBox 线路全长高差闭合差符合限差要求，如需保存结果，请点击“成果保存”按钮 End If End SubPrivate Sub Command8_Click() Dim i As Integer CD.Filter = 文本文件(*.txt)|*.txt|所有文件(*.*)|*.* CD.ShowOpen strfilename = CD.FileName Open strfilename For Output As #2 For i = 1 To n Print #2, 第 & i & 测站视线长： & ds(i) & m, Print #2, 高差改正数： & Format(detht(i), 0.000) & m, Print #2, 改后高差： & Format(ht(i), 0.000) & m, Print #2, 高程： & Format(zh(i), 0.000) & m Next i Print #2, 路线全长： & Format(sds / 1000, 0.000) & km Print #2, 路线全长高差闭合差： & Format(fht, 0.000) & m Print #2, 限差：