📄 导线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 + -