?? 導線4.frm
字號:
VERSION 5.00
Begin VB.Form Form4
Caption = "Form4"
ClientHeight = 9015
ClientLeft = 60
ClientTop = 450
ClientWidth = 10290
LinkTopic = "Form4"
ScaleHeight = 9015
ScaleWidth = 10290
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "退出"
Height = 855
Left = 4440
TabIndex = 4
Top = 2280
Width = 735
End
Begin VB.PictureBox Picture3
Height = 5175
Left = 120
ScaleHeight = 5115
ScaleWidth = 10035
TabIndex = 3
Top = 3840
Width = 10095
End
Begin VB.PictureBox Picture1
Height = 3615
Left = 0
ScaleHeight = 3555
ScaleWidth = 4395
TabIndex = 2
Top = 120
Width = 4455
End
Begin VB.PictureBox Picture2
Height = 3615
Left = 5160
ScaleHeight = 3555
ScaleWidth = 5115
TabIndex = 1
Top = 120
Width = 5175
End
Begin VB.CommandButton Command1
Caption = "輸出結果"
Height = 855
Left = 4440
TabIndex = 0
Top = 720
Width = 735
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim x(0 To 11) As Double
Dim y(0 To 11) As Double
Dim s(0 To 10) As Double
Dim s1(0 To 10) As Double
Dim a(0 To 10) As Double
Dim dx(0 To 10) As Double
Dim dy(0 To 10) As Double
Dim c(0 To 10) As Double
Dim b(0 To 10) As Double
Dim e(0 To 10) As Double
Dim f(0 To 10) As Double
Dim t1(0 To 10) As Double
Private Sub Command1_Click()
Dim i As Integer
Dim st, a1 As String
Dim se As String
Dim ddx, ddy, ss As Double
Dim b1$
Dim bb(1 To 22, 1 To 20) As Double
Dim bt(1 To 20, 1 To 22), btb(1 To 20, 1 To 20), btl(1 To 20), l(1 To 22), btb1(1 To 20, 1 To 20) As Double
Dim dd(1 To 20), d As Double
Dim tt, p As Integer
Dim v(1 To 22) As Double
Dim m0, mx(1 To 10), my(1 To 10), m(1 To 10) As Double
Dim z, zz, ch, e1(1 To 20, 1 To 40), q(1 To 20, 1 To 20) As Double
Dim w1, w2 As Double
Dim t(0 To 10) As Double
w1 = 270
w2 = 180
x(0) = 1000 '起點坐標x.y
y(0) = 2000
x(1) = 1000
For i = 0 To 10 '賦予邊長s 角度a
s(i) = Form2.Text2(i)
a(i) = Form2.Text1(i)
Next i
t(0) = w1 * 3.141592654 / w2 '初始方向角t
For i = 1 To 10 '計算導線各邊方向角t
If t(i - 1) > 3.141592654 Then
t(i) = t(i - 1) - 3.141592654 + a(i)
Else:
t(i) = t(i - 1) + 3.141592654 + a(i)
End If
If t(i) > 2 * 3.141592654 Then t(i) = t(i) - 2 * 3.141592654
Next i
dx(0) = 0 '計算坐標增量dx,dy 計算近似坐標值x y
dy(0) = -s(0)
For i = 2 To 11
dx(i - 1) = s(i - 1) * Cos(t(i - 1))
x(i) = x(i - 1) + dx(i - 1)
Next i
For i = 1 To 10
y(i) = y(i - 1) + dy(i - 1)
dy(i) = s(i) * Sin(t(i))
Next i
y(11) = y(10) + dy(10)
Picture1.Print "坐標近似值"
For i = 0 To 10
st = "坐標x" & i & "=" & x(i)
se = "坐標y" & i & "=" & y(i)
Picture1.Print Tab(1); st; Tab(26); se
Next i
ddx = x(0) - x(11) '計算近似坐標的閉合差ddx ddy
ddy = y(0) - y(11)
st = "坐標差x" & i & "=" & ddx
se = "坐標差y" & i & "=" & ddy
Picture1.Print "近似坐標的閉合差"
Picture1.Print Tab(1); st; Tab(15); se
ss = 0 '計算導線邊總長
For i = 0 To 10
ss = ss + s(i)
Next i
For i = 0 To 10 '改正坐標閉合差
x(i + 1) = x(i + 1) + ddx * s(i) / ss
y(i + 1) = y(i + 1) + ddy * s(i) / ss
Next i
For i = 0 To 9 '經閉合差改正的坐標增量dx dy
dx(i) = ddx * s(i) / ss + dx(i)
dy(i) = ddy * s(i) / ss + dy(i)
s1(i) = Sqr(dx(i) * dx(i) + dy(i) * dy(i)) '計算邊長s1
c(i) = 206265 * dy(i) / (s(i) * s(i)) '方向值系數c b
b(i) = -206265 * dx(i) / (s(i) * s(i))
If (dx(i) > 0 And dy(i) > 0) Then t1(i) = Atn(dy(i) / dx(i)) '計算近似方向角t1
If (dx(i) < 0 And dy(i) > 0) Then t1(i) = 3.141592654 - Atn(-dy(i) / dx(i))
If (dx(i) < 0 And dy(i) < 0) Then t1(i) = 3.141592654 + Atn(dy(i) / dx(i))
If (dx(i) > 0 And dy(i) < 0) Then t1(i) = 2 * 3.141592654 - Atn(-dy(i) / dx(i))
Next i
dx(10) = x(0) - x(10)
dy(10) = y(0) - y(10)
s1(10) = Sqr(dx(10) * dx(10) + dy(10) * dy(10))
c(10) = 206265 * dy(10) / (s(10) * s(10))
b(10) = -206265 * dx(10) / (s(10) * s(10))
If (dx(10) > 0 And dy(10) > 0) Then t1(10) = Atn(dy(10) / dx(10))
If (dx(10) < 0 And dy(10) > 0) Then t1(10) = 3.141592654 - Atn(-dy(10) / dx(10))
If (dx(10) < 0 And dy(10) < 0) Then t1(10) = 3.141592654 + Atn(dy(10) / dx(10))
If (dx(10) > 0 And dy(10) < 0) Then t1(10) = 2 * 3.141592654 - Atn(-dy(10) / dx(10))
'計算邊長系數e f
For i = 0 To 10
e(i) = -dx(i) / s1(i)
f(i) = -dy(i) / s1(i)
Next i
For i = 1 To 22
If i = 1 Then
bb(i, i) = -c(i - 1)
bb(i, i + 1) = -b(i - 1)
ElseIf i < 11 Then
bb(i, (i - 1) * 2 - 1) = c(i - 1)
bb(i, (i - 1) * 2) = b(i - 1)
bb(i, (i - 1) * 2 + 1) = -c(i - 1)
bb(i, (i - 1) * 2 + 2) = -b(i - 1)
ElseIf i = 11 Then
bb(i, (i - 1) * 2 - 1) = c(i - 1)
bb(i, (i - 1) * 2) = b(i - 1)
bb(i, 1) = -c(i - 1)
bb(i, 2) = -b(i - 1)
ElseIf i = 12 Then
bb(i, i - 11) = -e(i - 12)
bb(i, i - 10) = -f(i - 12)
ElseIf i < 22 Then
bb(i, (i - 12) * 2 - 1) = e(i - 12)
bb(i, (i - 12) * 2) = f(i - 12)
bb(i, (i - 12) * 2 + 1) = -e(i - 12)
bb(i, (i - 12) * 2 + 2) = -f(i - 12)
Else
bb(i, 19) = e(10)
bb(i, 20) = f(10)
bb(i, 1) = -e(10)
bb(i, 2) = -f(10)
End If
Next i
For i = 1 To 22
If i < 12 Then
l(i) = (t(i - 1) - t1(i - 1)) * 206265
Else
l(i) = s(i - 12) - s1(i - 12)
End If
Next i
For i = 1 To 22 '轉置'
For j = 1 To 20
bt(j, i) = bb(i, j)
Next j
Next i
For i = 1 To 20 'BTB，BTL相乘'
For tt = 1 To 20
For j = 1 To 22
btb(i, tt) = btb(i, tt) + bt(i, j) * bb(j, tt)
Next j
Next tt
Next i
For i = 1 To 20
For j = 1 To 20
btb1(i, j) = btb(i, j)
Next j
Next i
For i = 1 To 20
btl(i) = 0
For j = 1 To 22
btl(i) = btl(i) + bt(i, j) * l(j)
Next j
Next i
For k = 1 To 19 '求改正數dd()'
For j = k + 1 To 20
btb(k, j) = btb(k, j) / btb(k, k)
Next j
btl(k) = btl(k) / btb(k, k)
For i = k + 1 To 20
For j = k + 1 To 20
btb(i, j) = btb(i, j) - btb(i, k) * btb(k, j)
Next j
btl(i) = btl(i) - btb(i, k) * btl(k)
Next i
Next k
d = 0
dd(20) = btl(20) / btb(20, 20)
For i = 19 To 1 Step -1
For j = i + 1 To 20
d = d + btb(i, j) * dd(j)
Next j
dd(i) = btl(i) - d
d = 0
Next i
For i = 1 To 10
x(i) = x(i) + dd(2 * i - 1)
y(i) = y(i) + dd(2 * i)
Next i
Picture2.Print "坐標近似值"
For i = 0 To 10
st = "坐標x" & i & "=" & x(i)
se = "坐標y" & i & "=" & y(i)
Picture2.Print Tab(1); st; Tab(26); se
Next i
For j = 1 To 22 '方向 邊長改正數v()
d = 0
For tt = 1 To 20
d = d + bb(j, tt) * dd(tt)
Next tt
v(j) = d - l(j)
Next j
Picture3.Print "方向改正數 邊長改正數"
j = 0
For i = 1 To 11
j = j + 1
Picture3.Print j; Tab(5); v(i); Tab(30); v(i + 11)
Next i
d = 0
For i = 1 To 22 '單位權中誤差m0'
d = d + v(i) * v(i)
Next i
m0 = Sqr(d / 2)
'協因數陣q()
For i = 1 To 20
For j = 1 To 20
e1(i, j) = btb1(i, j)
Next j
Next i
For i = 1 To 20
For j = 21 To 40
If i = j - 20 Then
e1(i, j) = 1
Else
e1(i, j) = 0
End If
Next j
Next i
For j = 1 To 20
If e1(j, j) = 0 Then
For i = 1 To 20
If e1(i, j) <> 0 Then Exit For
Next i
For p = 1 To 40
ch = e1(i, p)
e1(i, p) = e1(j, p)
e1(j, p) = ch
Next p
End If
z = e1(j, j)
For p = 1 To 40
e1(j, p) = e1(j, p) / z
Next p
For i = 1 To 20
If i <> j And e1(i, j) <> 0 Then
zz = e1(i, j)
For p = 1 To 20
e1(i, p) = e1(i, p) - e1(j, p) * zz
Next p
End If
Next i
Next j
For i = 1 To 20
For j = 1 To 20
q(i, j) = e1(i, j + 20)
Next j
Next i
For i = 1 To 10
mx(i) = m0 * Sqr(q(2 * i - 1, 2 * i - 1))
my(i) = m0 * Sqr(q(2 * i, 2 * i))
m(i) = Sqr(mx(i) * mx(i) + my(i) * my(i))
Next i
Picture2.Print
Picture2.Print "單位權中誤差m0=";
Picture2.Print m0
Picture3.Print "縱坐標中誤差 橫坐標中誤差 點位中誤差"
For i = 1 To 10
Picture3.Print Tab(1); mx(i); Tab(25); my(i); Tab(50); m(i)
Next i
End Sub
Private Function hdzh(hd$) As String
Dim d, f, s0, h, x As Double
Dim x1$, x2#
x2 = Val(hd)
x = x2 * 206265
d = Int(x / 3600)
f = Int((x / 3600 - d) * 60)
s0 = ((x / 3600 - d) * 60 - f) * 60
x1 = Str$(d) & "," & Str$(f) & "," & Str$(s0)
hdzh = x1
End Function
Private Sub Command2_Click()
End
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -