?? ??
字號:
VERSION 5.00
Begin VB.Form Form1
Caption = "水準后處理程序"
ClientHeight = 4230
ClientLeft = 60
ClientTop = 450
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 4230
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton 轉換三等科傻格式
Caption = "轉換三等科傻格式"
Height = 615
Left = 2520
TabIndex = 4
Top = 1680
Width = 1335
End
Begin VB.CommandButton 生成三等手簿
Caption = "生成三等手簿"
Height = 615
Left = 2520
TabIndex = 3
Top = 480
Width = 1335
End
Begin VB.CommandButton 關閉
Caption = "關閉"
Height = 615
Left = 1440
TabIndex = 2
Top = 3000
Width = 1335
End
Begin VB.CommandButton 轉換手簿格式
Caption = "生成四等手簿"
Height = 615
Left = 480
TabIndex = 1
Top = 480
Width = 1335
End
Begin VB.CommandButton 轉換科傻格式
Caption = "轉換四等科傻格式"
Height = 615
Left = 480
TabIndex = 0
Top = 1680
Width = 1335
End
Begin VB.Line Line5
X1 = 2160
X2 = 2160
Y1 = 2520
Y2 = 360
End
Begin VB.Line Line4
X1 = 360
X2 = 360
Y1 = 2520
Y2 = 360
End
Begin VB.Line Line3
X1 = 3960
X2 = 3960
Y1 = 2520
Y2 = 360
End
Begin VB.Line Line2
X1 = 360
X2 = 3960
Y1 = 360
Y2 = 360
End
Begin VB.Line Line1
X1 = 3960
X2 = 360
Y1 = 2520
Y2 = 2520
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Dim ki
Dim folderexist As String
Dim fso As New FileSystemObject
If fso.FolderExists("C:\Program Files\水準后處理程序") = True Then
folderexist = True
FileCopy "C:\Program Files\水準后處理程序\外業水準手簿.doc", "d:\外業水準手簿.doc"
Else
folderexist = False
ki = MsgBox("水準后處理程序安裝時不允許更改目錄！")
End
End If
End Sub
Private Sub 關閉_Click()
End
End Sub
Private Sub 生成三等手簿_Click()
Dim wd As Word.Application
Dim myrange1 As Object
Dim i, j, n, hs, zhs, zds, hang As Long
Dim k, k1, k2, temp As Double
Dim a2(2500), a3(2500), a4(2500), a5(2500), a6(2500), a7(2500), dist, jj100, a9(2500), a10(2500), a11(2500), a12(2500) As Double
Dim a1(2500), a8(2500), qsd, jsd, dh As String
Dim ki
On Error Resume Next
Open "d:\B42.txt" For Input As #1
If Err Then
ki = MsgBox("先把文件從掌上電腦復制到D:\的根目錄下！")
Exit Sub
End If
i = 1
Do Until EOF(1)
Input #1, a1(i), a2(i), a3(i), a4(i), a5(i), a6(i), a7(i), a8(i), a9(i), a10(i), a11(i), a12(i)
i = i + 1
Loop
zhs = i - 1
Close #1
Set wd = New Word.Application
wd.Documents.Open "d:\外業水準手簿.doc"
wd.Visible = True
Set myrange1 = wd.ActiveDocument.Range
myrange1.Copy
biao = 1
n = 1
hs = 1
hang = 5
dist = 0
jj100 = 100
For i = 1 To zhs
If hs < 13 Then
If a1(i) = "0" And a6(i) <> "0" Then
k1 = a6(i): k2 = a7(i): qsd = a8(i)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=1).Range.InsertAfter "(" & qsd & ")" + Chr(13) + Chr(10)
ElseIf a1(i) = "1" Then
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=1).Range.InsertAfter CStr(n)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=2).Range.InsertAfter Format(a9(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=3).Range.InsertAfter Format(a10(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=1).Range.InsertAfter Format(a11(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=2).Range.InsertAfter Format(a12(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=1).Range.InsertAfter Format(a2(i), "#0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=5).Range.InsertAfter Format(a3(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=6).Range.InsertAfter Format(a4(i), "0000")
If (a3(i) + k2 - a4(i) > 10 Or a3(i) + k2 - a4(i) < -10) Then
temp = k1: k1 = k2: k2 = temp
End If
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=7).Range.InsertAfter a3(i) + k2 - a4(i)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=2).Range.InsertAfter Format(a5(i), "#0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=4).Range.InsertAfter Format(a6(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=5).Range.InsertAfter Format(a7(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=6).Range.InsertAfter a6(i) + k1 - a7(i)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=4).Range.InsertAfter Format((a3(i) - a6(i)), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=5).Range.InsertAfter Format((a4(i) - a7(i)), "0000")
If (a3(i) - a6(i) - (a4(i) - a7(i) - jj100) > 10 Or a3(i) - a6(i) - (a4(i) - a7(i) - jj100) < -10) Then
jj100 = -jj100
Else
End If
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=6).Range.InsertAfter a3(i) - a6(i) - (a4(i) - a7(i) - jj100)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=7).Range.InsertAfter Format(CStr((a3(i) - a6(i) + (a4(i) - a7(i) - jj100)) * 0.5), "0000.0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 3, Column:=1).Range.InsertAfter Format((a2(i) - a5(i)) / 10, "##0.0")
dist = dist + (a2(i) - a5(i)) / 10
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 3, Column:=2).Range.InsertAfter Format(dist, "#0.0")
temp = k1: k1 = k2: k2 = temp
jj100 = -jj100
hang = hang + 4
n = n + 1
hs = hs + 1
ElseIf a1(i) = "3" Then
dh = a8(i)
ElseIf a1(i) = "4" Then
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=1).Range.InsertAfter CStr(n) + Chr(13) + Chr(10)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=1).Range.InsertAfter "(" & dh & ")"
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=2).Range.InsertAfter Format(a9(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=3).Range.InsertAfter Format(a10(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=1).Range.InsertAfter Format(a11(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=2).Range.InsertAfter Format(a12(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=1).Range.InsertAfter Format(a2(i), "#0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=5).Range.InsertAfter Format(a3(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=6).Range.InsertAfter Format(a4(i), "0000")
If (a3(i) + k2 - a4(i) > 10 Or a3(i) + k2 - a4(i) < -10) Then
temp = k1: k1 = k2: k2 = temp
Else
End If
wd.ActiveDocument.Tables(biao).Cell(Row:=hang, Column:=7).Range.InsertAfter a3(i) + k2 - a4(i)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=2).Range.InsertAfter Format(a5(i), "#0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=4).Range.InsertAfter Format(a6(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=5).Range.InsertAfter Format(a7(i), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 1, Column:=6).Range.InsertAfter a6(i) + k1 - a7(i)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=4).Range.InsertAfter Format((a3(i) - a6(i)), "0000")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=5).Range.InsertAfter Format((a4(i) - a7(i)), "0000")
If (a3(i) - a6(i) - (a4(i) - a7(i) - jj100) > 10 Or a3(i) - a6(i) - (a4(i) - a7(i) - jj100) < -10) Then
jj100 = -jj100
Else
End If
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=6).Range.InsertAfter a3(i) - a6(i) - (a4(i) - a7(i) - jj100)
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 2, Column:=7).Range.InsertAfter Format(CStr((a3(i) - a6(i) + (a4(i) - a7(i) - jj100)) * 0.5), "0000.0")
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 3, Column:=1).Range.InsertAfter Format((a2(i) - a5(i)) / 10, "##0.0")
dist = dist + (a2(i) - a5(i)) / 10
wd.ActiveDocument.Tables(biao).Cell(Row:=hang + 3, Column:=2).Range.InsertAfter Format(dist, "#0.0")
temp = k1: k1 = k2: k2 = temp
jj100 = -jj100
hang = hang + 4
n = n + 1
hs = hs + 1
ElseIf (a1(i) = "0" And a6(i) = "0") Then
If hs - 1 Mod 12 <> 0 Then
If a1(i - 1) = 1 Then
wd.ActiveDocument.Tables(biao).Cell(Row:=hang - 4, Column:=1).Range.InsertAfter Chr(13) + Chr(10) + "(" & a8(i) & ")"
Else
End If
biao = biao + 1
hs = 1
hang = 5
n = 1
dist = 0
myrange1.SetRange Start:=wd.ActiveDocument.Range.End + 100, End:=wd.ActiveDocument.Range.End + 100
myrange1.Paste
Else
'wd.ActiveDocument.Tables(biao - 1).Cell(Row:=49, Column:=1).Range.InsertAfter Chr(13) + Chr(10) + "(" & a8(i) & ")"
hs = 1
hang = 5
n = 1
dist = 0
End If
Else
End If
Else
myrange1.SetRange Start:=wd.ActiveDocument.Range.End + 100, End:=wd.ActiveDocument.Range.End + 100
myrange1.Paste
biao = biao + 1
hs = 1
hang = 5
i = i - 1
End If
Next i
End Sub
Private Sub 轉換科傻格式_Click()
Dim i, j, n, hs, zhs, zds, jsgd As Integer
Dim k, k1, k2, temp As Double
Dim yzd(100), gc(100), gaocha As Double
Dim a2(5000), a3(5000), a4(5000), a5(5000), a6(5000), a7(5000), dist, d(5000), g(5000), jj100 As Double
Dim a1(5000), a8(5000), kzddh(5000), jsdh(5000), qsd, jsd, dh As String
Dim ki
On Error Resume Next
Open "d:\b42.txt" For Input As #1
If Err Then
ki = MsgBox("先把b42文件從掌上電腦復制到D:\的根目錄下！")
Exit Sub
End If
i = 1
Do Until EOF(1)
Input #1, a1(i), a2(i), a3(i), a4(i), a5(i), a6(i), a7(i), a8(i)
i = i + 1
Loop
zhs = i - 1
Close #1
Open "d:\knownheightpoint.txt" For Input As #2
If Err Then
ki = MsgBox("先把knownheightpoint文件從掌上電腦復制到D:\的根目錄下！")
Exit Sub
Else
End If
i = 1
Do Until EOF(2)
Input #2, yzd(i), gc(i)
i = i + 1
Loop
zds = i - 1
Close #2
Open "d:\科傻IN1水準格式.in1" For Output As #3
For i = 1 To zds
Print #3, yzd(i) & "," & Format(gc(i), "#0.000")
Next i
k = 1
dist = 0
gaocha = 0
hs = 1
For i = 1 To zhs
If a1(i) = "0" And a6(i) <> "0" Then
k1 = a6(i): k2 = a7(i)
kzddh(hs) = a8(i)
ElseIf a1(i) = "1" Then
dist = dist + a2(i) + a5(i)
If (a3(i) - a6(i) - (a4(i) - a7(i) + k1 - k2) > 10 Or a3(i) - a6(i) - (a4(i) - a7(i) + k1 - k2) < -10) Then
temp = k1: k1 = k2: k2 = temp
Else
End If
gaocha = gaocha + (a3(i) - a6(i) + (a4(i) - a7(i) + k1 - k2)) * 0.5
jsgd = i
ElseIf a1(i) = "3" Then
k = k + 1
hs = hs + 1
kzddh(hs) = a8(i)
ElseIf a1(i) = "4" Then
d(k) = dist + a2(i) + a5(i)
If (a3(i) - a6(i) - (a4(i) - a7(i) + k1 - k2) > 10 Or a3(i) - a6(i) - (a4(i) - a7(i) + k1 - k2) < -10) Then
temp = k1: k1 = k2: k2 = temp
Else
End If
g(k) = gaocha + (a3(i) - a6(i) + (a4(i) - a7(i) + k1 - k2)) * 0.5
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -