參考文獻
(1)王銘鋒(2005),「可視化收斂圍束法在隧道工程之應用」,碩 士
論文,中華大學土木工程系,新竹。
(2)陳聖彥(2004),「視窗化收斂圍束法在隧道工程之研究與應 用」,碩士論文,中華大學土木工程系,新竹。
(3)陳堯中,吳俊傑,傅子仁 (1998),「隧道變形量測及斷面收 方之自動化技術」,地工技術雜誌,第65 期,第 43~52 頁。
(4)陳堯中,翁世樑,張文城 (1995),「隧道工程監測自動化技 術引進及推廣」,內政部營建署營建自動化專業計畫成果報告,
共 123 頁。
(5)陳堯中,姚錫齡,魏錦銘(1991),「隧道斷面自動量測儀之 研製」, 內政部建築研究所籌備處專題研究計畫成果報告,共 63 頁。
(6)許榮達(2004),「隧道斷面收方技術開發與工程應用之研究」,
碩士論文,中華大學土木工程系,新竹。
(7)黃水木(1999),「路線測量與土石方計算」,茂榮圖書有限公 司。
(8)葉怡成(1991) ,「測量學-21 世紀觀點」,東華書局,台灣台 北。
(9)蔡茂生(1998),「山岳隧道施工自動化」,地工技術雜誌,第 6
期,第5~18 頁。
(10)楊道昌,游保杉(2002),「區域連續行降雨-逕流模式視窗 化
軟體之發展與應用」, 土木水利第二十八卷第四期 pp.106~117。
(11)楊森閔(2002),「由現地基樁試驗資料歸納土壤 P-Y 曲線」,
碩士論文,國立台灣大學土木工程研究所,台北。
(12)管晏如(1990),「測量學」,有寧出版有限公司,台灣台北。
(13)管晏如(1991),「電子測距」,國立編譯館出版,台灣台北。
(14).Leica Profiler 4000 PRO-SYS 6.0 Software Manual
(15) Leica TCR307 操作手冊
(16).Leica TCR1101 操作手冊
附 錄
附錄 程式碼
Dim minX As Long Dim minY As Long Dim maxX As Long Dim maxY As Long
Dim design_data() As MYDATA Dim measure_data() As MYDATA
Dim cx, cy, pi Dim fname
Dim connectionText As String
Dim con As New ADODB.Connection Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA"
(ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Sub Initialize()
Db = App.Path & "\" & "ouvd.mdb"
connectiontxt = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\" & "ouvd.mdb"
con.Open connectiontxt
cmd.ActiveConnection = con '初始化選單資訊 End Sub
Private Sub Command1_Click()
End Sub
Private Sub Command2_Click()
Dim n As Integer, i As Integer, a As Integer Dim c As Single, length As Single
n = 90
For i = 1 To n
c = Int(Rnd() * 16)
length = (Rnd() * 20) + 1 Next
For a = 0 To 639 Step length
pic1.Line (a, 0)-(639 - a, 479), QBColor(c)
Next
For a = 0 To 479 Step length
pic1.Line (639, a)-(0, 479 - a), QBColor(c)
Next
End Sub
Private Sub DrawPic()
On Error GoTo fxxx Dim n As Integer n = 0
cmd.CommandText = "select * from design_xy where mode=" &
Text24
Set rs = cmd.Execute 'rs.MoveFirst
While rs.EOF = False
ReDim Preserve design_data(n)
design_data(n).X = rs.Fields(2) * 1000
design_data(n).Y = (rs.Fields(3) * 1000) +
(CSng(Text102.Text) * 1000) + 0.1 * 1000 'Print d(n).y
n = n + 1 rs.MoveNext
Wend
' 找最大範圍 For i = 0 To n - 1 If i = 0 Then
maxX = GetMaxRange(design_data(i).X)
maxY = GetMaxRange(design_data(i).Y)
minX = GetMinRange(design_data(i).X)
minY = GetMinRange(design_data(i).Y)
Else
If design_data(i).X > maxX Then maxX = GetMaxRange(design_data(i).X)
If design_data(i).Y > maxY Then maxY = GetMaxRange(design_data(i).Y)
If design_data(i).X < minX Then minX = GetMinRange(design_data(i).X)
If design_data(i).Y < minY Then minY = GetMinRange(design_data(i).Y)
End If Next
'================================================
========
'抓取測量斷面資料
n = 0
For i = 0 To MSFlexGrid1.rows - 1
ReDim Preserve measure_data(n)
MSFlexGrid1.row = i MSFlexGrid1.col = 0
measure_data(n).X = CSng(MSFlexGrid1.Text) * 1000
MSFlexGrid1.row = i MSFlexGrid1.col = 1
measure_data(n).Y = CSng(MSFlexGrid1.Text) * 1000 n = n + 1
Next
' 找最大範圍 For i = 0 To n - 1
If measure_data(i).X > maxX Then maxX = GetMaxRange(measure_data(i).X)
If measure_data(i).Y > maxY Then maxY = GetMaxRange(measure_data(i).Y)
If measure_data(i).X < minX Then minX = GetMinRange(measure_data(i).X)
If measure_data(i).Y < minY Then minY = GetMinRange(measure_data(i).Y)
Next
'================================================
=======================
'定義繪圖物件
Dim DrawMaxX As Long Dim DrawMinX As Long Dim DrawMaxY As Long Dim DrawMinY As Long DrawMaxX = maxX + 1000 DrawMinX = minX - 1000 DrawMaxY = maxY + 1000 DrawMinY = minY - 1000
Picture7.Cls
Picture7.Scale (DrawMaxX, DrawMaxY)-(DrawMinX - 100, DrawMinY - 100)
Picture7.DrawWidth = 1 Picture7.DrawStyle = 2
For i = DrawMaxX To DrawMinX Step -1000
Picture7.Line (i, DrawMaxY)-(i, DrawMinY)
Next
For i = DrawMaxY To DrawMinY Step -1000
Picture7.Line (DrawMaxX, i)-(DrawMinX, i)
Next
design_exy measure_xy
Exit Sub fxxx:
MsgBox "資料不完整 如遺漏設計斷面高等 請檢查後 再行操作"
End Sub
Private Sub Command4_Click()
Form9.Show 'Form9 GASIO NO.2
End Sub
Private Sub Command9_Click()
dlgcommon1.Filter = "TXT (*.txt;*,csv) |*.txt;*.csv"
dlgcommon1.InitDir = "\"
dlgcommon1.DialogTitle = "選取所要匯入的檔案"
dlgcommon1.ShowOpen
showTxt = dlgcommon1.FileName txt = dlgcommon1.FileName
If Len(txt) <= 0 Or IsNull(txt) Then Exit Sub
Dim inputFile As Integer inputFile = FreeFile
Open txt For Input As #inputFile
Do While Not EOF(inputFile)
Line Input #inputFile, aline temp = Split(aline, ",")
Me.MSFlexGrid1.rows = Me.MSFlexGrid1.rows + 1
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 0)
= IIf(temp(0) = "", 0, temp(0))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 1)
= IIf(temp(1) = "", 0, temp(1))
Loop
Me.MSFlexGrid1.RemoveItem (Me.MSFlexGrid1.row)
Close #inputFile 'Excel 檔 匯入
MsgBox "匯入結束"
End Sub
Private Sub mnuData_Click()
Form4.Show End Sub
Private Sub mnuopennew_Click()
Form2.Show '資訊視窗 End Sub
Private Sub mnusupport_Click(Index As Integer)
Form6.Show End Sub
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
OldX = MSFlexGrid1.col
OldY = MSFlexGrid1.row '定義滑鼠座標
End Sub
Private Sub Form_Load()
Dim i As Integer, j As Integer, k As Integer
MSFlexGrid1.ColWidth(0) = 950 MSFlexGrid1.ColWidth(1) = 1000
MSFlexGrid2.ColWidth(0) = 800 MSFlexGrid2.ColWidth(1) = 1100 MSFlexGrid2.ColWidth(2) = 1100
MSFlexGrid2.ColWidth(3) = 700 '設定 Grid1 的格子寬度
pi = 3.14159 cx = 320 cy = 240
pic1.ScaleMode = 3
pic1.Scale (0, 0)-(640, 480)
set_color For i = 0 To 47
Pic2(i).BackColor = color(i)
Next '初始設定
Initialize
Text3 = ""
Text4 = ""
Text5 = ""
Text7 = ""
Text8 = ""
Text9 = ""
Text10 = ""
Text11 = ""
Text12 = ""
Text13 = ""
Text14 = ""
Text15 = ""
Text16 = ""
Text17 = ""
Text18 = ""
Text19 = ""
Text20 = ""
Text21 = ""
End Sub
Private Sub Command7_Click()
Dim d() As MYDATA Dim n As Integer
Dim RowSel As Integer Dim ColSel As Integer
RowSel = MSFlexGrid1.RowSel ColSel = MSFlexGrid1.ColSel
Dim i As Long
For i = OldY To RowSel ReDim Preserve d(n)
MSFlexGrid1.row = i MSFlexGrid1.col = OldX
d(n).X = CSng(MSFlexGrid1.Text) * 1000
MSFlexGrid1.row = i
MSFlexGrid1.col = OldX + 1
d(n).Y = CSng(MSFlexGrid1.Text) * 1000 n = n + 1
Next
For i = 0 To n - 1
If i = 0 Then
minX = d(i).X minY = d(i).Y maxX = d(i).X maxY = d(i).Y Else
If d(i).X > maxX Then maxX = d(i).X If d(i).Y > maxY Then maxY = d(i).Y If d(i).X < minX Then minX = d(i).X If d(i).Y < minY Then minY = d(i).Y End If
Next
Picture7.Scale (maxX + 1000, maxY + 1000)-(minX - 1000, minY - 1000)
Picture7.DrawWidth = 1 Picture7.DrawStyle = 2
Picture7.DrawWidth = 3 Picture7.DrawStyle = 0 For i = 0 To n - 1
Picture7.PSet (d(i).X, d(i).Y)
Next
Picture7.DrawWidth = 1 For i = 0 To n - 1
If i = 0 Then
Picture7.PSet (d(i).X, d(i).Y)
Else
Picture7.Line -(d(i).X, d(i).Y), vbBlue End If
Next End Sub
Private Sub mmufileend_Click()
End '結束程式 End Sub
Private Sub Pic2_Click(Index As Integer)
pic1.ForeColor = color(Index)
pic3.BackColor = color(Index)
End Sub
Sub design_exy()
Dim OldX As Single Dim OldY As Single
Dim n As Integer
n = UBound(design_data)
Picture7.DrawWidth = 3 Picture7.DrawStyle = 0
For i = 0 To n - 1
Picture7.PSet (design_data(i).X, design_data(i).Y), vbRed
Next
Picture7.DrawWidth = 1
For i = 0 To n - 1
If i = 0 Then Picture7.PSet (design_data(i).X, design_data(i).Y)
Next
'設計段面線
Picture7.DrawWidth = 5
Picture7.PSet (0, (Val(Text102) + 0.1) * 1000), vbBlack
'設計中心點
Picture7.DrawWidth = 2
Picture7.Line (-1000, Val(Text102) * 1000)-(1000, Val(Text102) * 1000), vbRed
'設計高程線
Picture7.DrawWidth = 2 End Sub
Sub measure_xy()
Dim OldX As Single Dim OldY As Single Dim d() As MYDATA
Dim n As Integer
n = UBound(measure_data)
Picture7.DrawWidth = 3 Picture7.DrawStyle = 0 For i = 0 To n - 1
Picture7.PSet (measure_data(i).X, measure_data(i).Y)
Next
Picture7.DrawWidth = 1
For i = 0 To n - 1 If i = 0 Then
Picture7.PSet (measure_data(i).X, measure_data(i).Y)
Else
Picture7.Line -(measure_data(i).X, measure_data(i).Y), vbBlue
End If Next
End Sub
Private Sub VScroll2_Change()
Text24.Text = VScroll2.Value End Sub
Private Sub Text24_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text24_LostFocus
End Sub
Private Sub Text24_Change()
Select Case Text24 Case "0"
Picture7.Cls
Text25 = "選擇斷面形式(1~6)"
Exit Sub Case "1"
Text25 = "混凝土面"
Label2 = "隧道斷面測量圖"
Picture1.Visible = True Case "2"
Text25 = "完成面"
Label2 = "隧道斷面測量圖"
Case "3"
Text25 = "避車(左)完成面"
Label2 = "隧道斷面測量圖"
Case "4"
Text25 = "避車(右)完成面"
Label2 = "隧道斷面測量圖"
Case "5"
Text25 = "避車(左)噴凝土面"
Label2 = "隧道斷面測量圖"
Case "6"
Text25 = "避車(右)噴凝土面"
Label2 = "隧道斷面測量圖"
Case Else
Text24 = "0"
Exit Sub End Select DrawPic
End Sub
Private Sub Text24_LostFocus()
If IsNumeric(Text24.Text) = False Then MsgBox "必需是輸入數值才可以", 16
Text24.Text = VScroll2.Max - VScroll2.Value End If
If Val(Text24.Text) > VScroll2.Max Or Val(Text24.Text) < 0 Then
MsgBox "數值範圍是 0 ~ " & VScroll2.Max, 16 Text24.Text = VScroll2.Max - VScroll2.Value End If
End Sub
Function GetMaxRange(d As Single) As Long
Dim tmp As Long tmp = d / 1000 tmp = tmp + 1
GetMaxRange = tmp * 1000 End Function
Function GetMinRange(d As Single) As Long Dim tmp As Long
tmp = d / 1000 tmp = tmp - 1
GetMinRange = tmp * 1000 End Function
Private Sub Combo1_Click()
Dim r As String r = Combo1.Text
If r = "混凝土面" Then Text15 = "1"
If r = "完成面" Then Text15 = "2"
If r = "避車(左)完成面" Then Text15 = "3"
If r = "避車(右)完成面" Then Text15 = "4"
If r = "避車(左)混凝土面" Then Text15 = "5"
If r = "避車(右)混凝土面" Then Text15 = "6"
End Sub
Private Sub Command1_Click()
Form4.Text105 = Text105 Form4.Text101 = Text101 Form4.Text102 = Text102 Form4.Text103 = Text103 Form4.Text104 = Text104 Form4.Text150 = Text15 Form4.Show
Me.Hide
End Sub
Private Sub Form_Load()
Combo1.AddItem "混凝土面"
Combo1.AddItem "完成面"
Combo1.AddItem "避車(左)完成面"
Combo1.AddItem "避車(右)完成面"
Combo1.AddItem "避車(左)混凝土面"
Combo1.AddItem "避車(右)混凝土面"
Combo1.SelText = "混凝土面"
End Sub
Dim connectionText As String
Dim con As New ADODB.Connection Dim cmd As New ADODB.Command Dim rs As New ADODB.Recordset
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" ()
As Long '以上為宣告區
Function Round1(num As Variant, n As Long) As String
Round1 = Format(num, IIf(n > 0, "0." & String(n, "0"),
"0"))
End Function
Function Asin(ByVal X As Single) As Double
If (1 - X ^ 2) <= 0 Then Asin = 0
Else
Asin = Atn(X / Sqr(1 - X ^ 2)) / 0.0174532925 End If
'Asin 求法 End Function
Function Comp(obj As MSFlexGrid, col As Integer, ByVal mode As Integer)
Dim tmp, row As Integer For row = 0 To obj.rows - 1 If row = 0 Then
tmp = Val(obj.TextMatrix(row, col))
Else
Select Case mode Case 1
tmp = GetMax(tmp, Val(obj.TextMatrix(row, col)))
Case 2
tmp = GetMin(tmp, Val(obj.TextMatrix(row, col)))
End Select End If
Next
Comp = tmp
End Function
Function GetMax(ByVal data1 As Integer, ByVal data2 As Integer)
As Integer
If data1 > data2 Then GetMax = data1 Else
GetMax = data2 End If
End Function
Function GetMin(ByVal data1 As Integer, ByVal data2 As Integer) As Integer
If data1 < data2 Then GetMin = data1 Else
GetMin = data2 End If
End Function
Function Comp2(obj As MSFlexGrid, col As Integer) As Integer ' 取 次大直
Dim tmp(2), row As Integer For row = 0 To obj.rows - 1
' tmp(0) 第一大 tmp(1) 第二大
For i = 0 To 1
If tmp(i) < Val(obj.TextMatrix(row, col)) Then If i = 0 Then
tmp(i + 1) = tmp(i)
End If
tmp(i) = Val(obj.TextMatrix(row, col))
Exit For End If
Next Next
Comp2 = tmp(1)
End Function
Function Comp3(obj As MSFlexGrid, col As Integer) As Integer ' 取 次小直
Dim tmp(2), row As Integer
tmp(0) = Comp2(MSFlexGrid4, 0)
tmp(1) = Comp(MSFlexGrid4, 0, 1)
For row = 0 To obj.rows - 1
' tmp(0) 第一小 tmp(1) 第二小 For i = 0 To 1
If tmp(i) > Val(obj.TextMatrix(row, col)) Then If i = 0 Then
tmp(i + 1) = tmp(i)
End If
tmp(i) = Val(obj.TextMatrix(row, col))
Exit For End If
Next Next
Comp3 = tmp(1)
End Function
Function GetAvg(obj As MSFlexGrid, col As Integer) As Double ' 取 平均值
Dim sum As Double Dim row As Integer
For row = 0 To obj.rows - 1
sum = sum + Val(obj.TextMatrix(row, col))
Next
GetAvg = sum / (row)
End Function
Private Sub Command1_Click()
'新增中線資料鈕
Me.MSFlexGrid1.rows = Me.MSFlexGrid1.rows + 1
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 0) =
IIf(Text1(0) = "", 0, Text1(0))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 1) = IIf(Text1(1) = "", 0, Text1(1))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 2) = IIf(Text1(2) = "", 0, Text1(2))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 3) = IIf(Text1(3) = "", 0, Text1(3))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 4) = IIf(Text1(4) = "", 0, Text1(4))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 5) = IIf(Text1(5) = "", 0, Text1(5))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 6) = IIf(Text1(6) = "", 0, Text1(6))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 7) = IIf(Text1(7) = "", 0, Text1(7))
Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.rows - 1, 8) = IIf(Text1(8) = "", 0, Text1(8))
End Sub
Private Sub Command10_Click()
'開啟 EXCEL
Dim xls As Excel.Application Set xls = Excel.Application Dim book As Excel.Workbook
Set book = xls.Workbooks.Open("c:\150k.xls")
Dim sheet As Excel.Worksheet Set sheet = xls.Sheets(1)
Dim rows As Integer, cols As Integer Dim i As Integer, j As Integer
Dim k As Integer, l As Integer
For i = 45 To 71 For j = 1 To 27
sheet.Cells(i, 2) = MSFlexGrid1.TextMatrix(j, 1)
sheet.Cells(i, 3) = MSFlexGrid1.TextMatrix(j, 2)
sheet.Cells(i, 4) = MSFlexGrid1.TextMatrix(j, 3)
sheet.Cells(i, 5) = MSFlexGrid1.TextMatrix(j, 4)
sheet.Cells(i, 6) = MSFlexGrid1.TextMatrix(j, 5)
sheet.Cells(i, 7) = MSFlexGrid1.TextMatrix(j, 6)
sheet.Cells(i, 8) = MSFlexGrid1.TextMatrix(j, 7)
sheet.Cells(i, 9) = MSFlexGrid1.TextMatrix(j, 8)
Next Next
'Print sheet.Cells(1, 3)
'Print sheet.Cells(2, 3)
'sheet.PrintOut print 用
xls.DisplayAlerts = True xls.Quit
End Sub Sub c1()
'計算距離高差
Dim n As Integer
For i = 1 To MSFlexGrid1.rows - 1 n = n + 1
If n >= fg3.rows Then fg3.AddItem ""
fg3.col = 0 fg3.col = 1 fg3.col = 2 fg3.row = n
fg3.TextMatrix(n - 1, 0) =
Round(MSFlexGrid1.TextMatrix(i, 1) +
MSFlexGrid1.TextMatrix(i, 2) / 60 + MSFlexGrid1.TextMatrix(i, 3) / 3600, 2)
fg3.TextMatrix(n - 1, 1) =
Round((MSFlexGrid1.TextMatrix(i, 7) / 1000) * Sin((MSFlexGrid1.TextMatrix(i, 4) +
MSFlexGrid1.TextMatrix(i, 5) / 60 + MSFlexGrid1.TextMatrix(i, 6) / 3600) * 3.1415926 / 180), 3)
fg3.TextMatrix(n - 1, 2) =
Round((MSFlexGrid1.TextMatrix(i, 7) / 1000) * Cos((MSFlexGrid1.TextMatrix(i, 4) +
MSFlexGrid1.TextMatrix(i, 5) / 60 + MSFlexGrid1.TextMatrix(i, 6) / 3600) * 3.1415926 / 180), 3)
'高程 mm*弧度 End If
Next
'計算距離高差
Text15 = Round(Sqr((Val(Text7) - Val(Text3)) ^ 2 +
(Val(Text8) - Val(Text4)) ^ 2), 3) '已知測點距離
If Abs(Val(fg3.TextMatrix(1, 0)) - Val(fg3.TextMatrix(0, 0))) > 180 Then
Text16 = Round(360 - Abs(fg3.TextMatrix(1, 0) - fg3.TextMatrix(0, 0)), 3)
Else
Text16 = Round(Abs(fg3.TextMatrix(1, 0) - fg3.TextMatrix(0, 0)), 3)
End If '量測夾角
If Val(fg3.TextMatrix(1, 1)) > Val(fg3.TextMatrix(0, 1))
And Val(fg3.TextMatrix(1, 1)) > Val(Text15) Then Text19 = Round((180 - (Val(Text16) * 3.1415926 /
180)) * (fg3.TextMatrix(1, 1) / Val(Text15) * 3.1415926 / 180), 3)
Else
Text19 = Round((Val(Text16) * 3.1415926 / 180) *
(fg3.TextMatrix(1, 1) / Val(Text15) * 3.1415926 / 180), 3)
End If '
If Val(fg3.TextMatrix(0, 1)) > Val(fg3.TextMatrix(1, 1)) Or Val(fg3.TextMatrix(0, 1)) > Val(Text15) Then
Text20 = Round(180 - (Val(Text16) / 180 * 3.1415926) *
(fg3.TextMatrix(0, 1) / Val(Text15) / 3.1415926 * 180), 3)
Else
Text20 = Round((Val(Text16) / 180 * 3.1415926) * fg3.TextMatrix(0, 1) / Val(Text15) / 3.1415926 * 180, 3)
End If '
If Val(Text19) > Val(Text20) Then
Text17 = Round(180 - Val(Text16) - Val(Text20), 3)
Else
Text17 = Text19
End If '計算距離高差 已知點 1 內角計算 worng
If Val(Text20) > Val(Text19) Then
Text18 = Round(180 - Val(Text16) - Val(Text19), 3)
Else
Text18 = Text20
End If '計算距離高差 已知點 2 內角計算
Text21 = Round(((Val(Text16) + fg3.TextMatrix(0, 0))
/ 360 - Int((Val(Text16) + fg3.TextMatrix(0, 0)) / 360)) * 360, 3)
Text22 = Round(fg3.TextMatrix(1, 0), 3)
End Sub Sub c2()
'計算過程
Text37 = Round(Abs(Atn((Val(Text8) - Val(Text4)) /
(Val(Text7) - Val(Text3))) * 180 / 3.1415926), 3) '數學 方位角
If (Val(Text8) - Val(Text4)) >= 0 And (Val(Text7) - Val(Text3)) >= 0 Then Text38 = Text37
If (Val(Text8) - Val(Text4)) >= 0 And (Val(Text7) - Val(Text3)) < 0 Then Text38 = 180 - Val(Text37)
If (Val(Text8) - Val(Text4)) < 0 And (Val(Text7) - Val(Text3)) >= 0 Then Text38 = 360 - Val(Text37)
If (Val(Text8) - Val(Text4)) < 0 And (Val(Text7) -
Val(Text3)) < 0 Then Text38 = 180 + Val(Text37) '基線方位角 '計算過程
If Val(Text21) = Val(Text22) Then
Text24 = Round(Val(Text3) + (fg3.TextMatrix(0, 1) * Sin((90 - (Val(Text38) + Val(Text17))) / 180 *
3.1415926)), 3) '測站一算未知點 N
Text27 = Round(Val(Text4) + (fg3.TextMatrix(0, 1) * Cos((90 - (Val(Text38) + Val(Text17))) / 180 * 3.1415926)), 3) '測站一算未知點 E
Text25 = Round(Val(Text7) + (fg3.TextMatrix(1, 1) * Sin((90 - (Val(Text38) - 180 - Val(Text18))) / 180 * 3.1415926)), 3) '測站二算未知點 N
Text28 = Round(Val(Text8) + (fg3.TextMatrix(1, 1) * Cos((90 - (Val(Text38) - 180 - Val(Text18))) / 180 * 3.1415926)), 3) '測站二算未知點 E
Else
Text24 = Round(Val(Text3) + (fg3.TextMatrix(0, 1) * Sin((90 - (Val(Text38) - Val(Text17))) / 180 *
3.1415926)), 3) '測站一算未知點 N
Text27 = Round(Val(Text4) + (fg3.TextMatrix(0, 1) * Cos((90 - (Val(Text38) - Val(Text17))) / 180 *
3.1415926)), 3) '測站一算未知點 E
Text25 = Round(Val(Text7) + (fg3.TextMatrix(1, 1) *
Sin((90 - (Val(Text38) - 180 + Val(Text18))) / 180 * 3.1415926)), 3) '測站二算未知點 N
Text28 = Round(Val(Text8) + (fg3.TextMatrix(1, 1) * Cos((90 - (Val(Text38) - 180 + Val(Text18))) / 180 * 3.1415926)), 3) '測站二算未知點 E
End If
If Val(Text5) = 0 Then Text30 = 0
Else
Text30 = Round(Val(Text5) + MSFlexGrid1.TextMatrix(1, 8) - fg3.TextMatrix(0, 2), 3)
End If '測站一算未知點高程
If Val(Text9) = 0 Then Text31 = 0
Else
Text31 = Round(Val(Text9) + MSFlexGrid1.TextMatrix(2, 8) - fg3.TextMatrix(1, 2), 3)
End If '測站二算未知點高程
Text26 = Round(0.5 * (Val(Text24) + Val(Text25)), 3)
Text29 = Round(0.5 * (Val(Text27) + Val(Text28)), 3)
Text32 = Round(0.5 * (Val(Text30) + Val(Text31)), 3)
'平均值