Option Explicit
Dim sFind As String
'声明文件类型
Dim FileType, FiType As String
'初始化程序
Private Sub Form_Load() '设置程序启动时的大小
Me.Height = 6000
Me.Width = 8000
End Sub
'设置编辑框的位置和大小
Private Sub Form_Resize()
On Error Resume Next '出错处理
RichTextBox1.Top = 100
RichTextBox1.Left = 2
RichTextBox1.Height = ScaleHeight - 104
RichTextBox1.Width = ScaleWidth - 4
End Sub
'打开文件
Private Sub Open_Click()
CommonDialogl.Filter = "权属文档(*.hdm) |*. hdm| 文本文档( * . txt)| * . txt| 所有文件( *.*)| *. *"
CommonDialogl.ShowOpen
RichTextBoxl.Text = "" '清空文本框FileName = CommonDialogl. FileName
RichTextBoxl.LoadFile FileName
End Sub
'CASS 横断面文件转换为纬地横断 面文件
Private Sub zhuanhuan_Click()
Dim BEGEN, LICHENG As String '定义起始标志里程变量
Dim pjd As String '定义平距、高程变量
Dim k, n, m As String '记录位 置、横断面上的总点数、左断面的测点数变量
Open CommonDialogl.FileName For Input As #1
Open "c: \横断面线.txt" For Output As #2
Do While Not EOF(1)
Input #1, BEGEN, LICHENG ' 读入起始标志、里程、横断面数
k = Seek(l) '记录指针位置
测算一个横断面的总点数
n = 0
Do
Line Input #1, pjd '读入平距、高程
If Left(pjd, 5) = "BEGIN" Then Exit Do
n = n + 1
Loop While Not EOF(1)
Seek #1, k '指针回到前面
ReDim pjgc(n, 2) As Single '定义平距、高程
数组变量
将一个断面的平距和高程数据读入到数组
For i = 1 To n
For j = 1 To 2
Input #1, pjgc(i, j)
Next j
Nexti '测算一个横断面的左点数For i= 1 To n
For j = 1 To 2
If pjgc(i, j) = 0 Then m = i - 1
Next j
Next i
'写入纬地格式
Print #2, LICHENG '写入里程桩号
'写左断面数据
Print #2, m; "";
For i = m To 1 Step -1
For j = 1 To 2
Print #2, Format(pjgc(i + 1, j) - pjgc(i, j), "0.000"); "";
Next j
Print #2, "";
Next i
Print #2, ""
'写右断面数据
Print #2, n - m - 1; " ";
For i = 1 To n - m - 1
For j = 1 To 2
If j <> 1 Then
Print #2, Format(pjgc(i + (n - m - 1), j) - pjgc(i + (n - m), j), "0.000"); "";
Else
Print #2, Format(Abs(pjgc(i + (n - m - 1), j) - pjgc(i + (n - m), j)), "0.000"); "";
End If
Next j
Print #2, "";
Next i
Print #2, ""
Loop
Close #1
Close #2
FileName = "c: \横断面线.txt "
RichTextBoxl.LoadFile FileName
Kill "C: \横断面线.txt"
End Sub
'保存文件
Private Sub Save_Click()
CommonDialogl.Filter = " 横断面文档( *.txt)| *. txt l 所有文件( *- * )| * · * "
CommonDialogl.ShowSave
If CommonDialogl.FileName = "" Then
Exit Sub
End If
Open CommonDialogl.FileName For Output As #1
Print #1, RichTextBoxl.Text
Close #1
End Sub
