• 沒有找到結果。

結論與建議

在文檔中 中文摘要 (頁 84-156)

參考文獻

(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)

'平均值

在文檔中 中文摘要 (頁 84-156)

相關文件