📄 gpsjdgs.cls
字号:
Else
If D22 > 0 Then
t = Pi / 2
Else
t = -Pi / 2
End If
End If
If D11 <= 0 Then
t = Pi - t
Else
If D22 < 0 Then t = 2 * Pi + t
End If
End Sub
'边长方位角函数系数数组
Private Sub PBB(H1%, H2%, Hm%)
Dim k%, j%, D11 As Single, D22 As Single
Call P00(B, NX)
Call PST(H1, H2)
If Hm <> 0 Then
D11 = -Cos(t)
D22 = -Sin(t)
Else
D11 = rou * Sin(t) / (s * 100)
D22 = -rou * Cos(t) / (s * 100)
End If
k = 2 * (H1 - N0)
j = 2 * (H2 - N0)
If H1 > N0 Then
B(k - 1) = D11
B(k) = D22
End If
If H2 > N0 Then
B(j - 1) = -D11
B(j) = -D22
End If
End Sub
'矩阵求逆
Private Sub Reverse(a() As Single, N%)
ReDim Preserve a(N, 2 * N)
Dim k%, K1%, j%, i%
Dim c As Single
For i = 1 To N
a(i, N + i) = 1
Next i
For k = 1 To N
c = 1 / a(k, k)
For j = 1 To 2 * N
a(k, j) = c * a(k, j)
Next j
For K1 = 1 To N
If K1 <> k Then
c = -a(K1, k)
For j = 1 To 2 * N
a(K1, j) = a(K1, j) + c * a(k, j)
Next j
End If
Next K1
Next k
For i = 1 To N
For j = N + 1 To 2 * N
a(i, j - N) = a(i, j)
Next j
Next i
End Sub
'可靠性计算
Public Sub Kkxjs()
Dim k%, j%, N01%, i%, N1%, N2%, H1%, H2%
Dim Q11 As Single, Q12 As Single, Q22 As Single, a As Single, QQQ As Single, Ha As Single
Dim r11 As Single, r12 As Single, r21 As Single, r22 As Single, p11 As Single, p12 As Single, p22 As Single
Dim detaLx As Single, detaLy As Single, r3 As Single
R = 0
For k = 1 To N
N1 = BaseLine(k).Nk
N2 = BaseLine(k).Mh
If N1 > N0 Or N2 > N0 Then
Call P00(W, NX)
Call P00(B, NX)
If N1 > N0 Then
B(2 * (N1 - N0) - 1) = -1
W(2 * (N1 - N0) - 1) = -1
End If
If N2 > N0 Then
B(2 * (N2 - N0) - 1) = 1
W(2 * (N2 - N0) - 1) = 1
End If
Call PZZ
Q11 = 0#
For j = 1 To NX
Q11 = Q11 + z(j) * B(j)
Next j
Q11 = Abs(Q11)
Call P00(W, NX)
Call P00(B, NX)
If N1 > N0 Then
W(2 * (N1 - N0)) = -1
B(2 * (N1 - N0)) = -1
End If
If N2 > N0 Then
W(2 * (N2 - N0)) = 1
B(2 * (N2 - N0)) = 1
End If
Call PZZ
Q22 = 0#
For j = 1 To NX
Q22 = Q22 + z(j) * B(j)
Next j
Q22 = Abs(Q22)
Call P00(B, NX)
If N1 > N0 Then
B(2 * (N1 - N0) - 1) = -1
End If
If N2 > N0 Then
B(2 * (N2 - N0) - 1) = 1
End If
Q12 = 0#
For j = 1 To NX
Q12 = Q12 + z(j) * B(j)
Next j
p11 = BaseLine(k).P(1)
p12 = BaseLine(k).P(2)
p22 = BaseLine(k).P(3)
r11 = 1 - (Q11 * p11 + Q12 * p12)
r12 = 0 - (Q11 * p12 + Q12 * p22)
r21 = 0 - (Q12 * p11 + Q22 * p12)
r22 = 1 - (Q12 * p12 + Q22 * p22)
BaseLine(k).R(1) = r11
BaseLine(k).R(2) = r12
BaseLine(k).R(3) = r22
R = R + r11 + r22
detaLx = 4# / Sqr(Abs(p11 * r11 + p12 * r12))
detaLy = 4# / Sqr(Abs(p12 * r22 + p22 * r22))
BaseLine(k).detaLx = detaLx
BaseLine(k).detaLy = detaLy
detaLx = 4# * Sqr(Abs((1 - r11) / r11))
detaLy = 4# * Sqr(Abs((1 - r22) / r22))
BaseLine(k).detaFx = detaLx
BaseLine(k).detaFy = detaLy
End If
Next k
End Sub
'输出
Public Sub Print_Number()
Dim i%, EE$, k%, Max As Single, Min As Single, Mx As Single, My As Single, Mp As Single, E As Single, F As Single
Print #2, ""
Print #2, " 精 度 评 定 表"
Print #2, "__________________________________________________________________________________________"
Print #2, " NO. | Mx | My | Mp | E | F | Te | 点 名 "
Print #2, " | (cm) | (cm) | (cm) | (cm) | (cm) | (度) | "
Print #2, "_________|_________|__________|__________|___________|__________|___________|_____________"
For i = N0 + 1 To Np
Print #2, Tab(4); Format(Point(i).ID, "000"); Tab(10); "|"; Tab(12); Format(Point(i).Mx, "0.##0"); Tab(20); "|"; Tab(23); _
Format(Point(i).My, "0.##0"); Tab(31); "|"; Tab(34); Format(Point(i).Mp, "0.##0"); Tab(42); "|"; Tab(45); _
Format(Point(i).E, "0.##0"); Tab(54); "|"; Tab(57); Format(Point(i).F, "0.##0"); Tab(65); "|"; Tab(68); _
Format(Point(i).Et, "000.##0"); Tab(77); "|"; Tab(79); Point(i).Name '; Tab(91); "|"
Print #2, "_________|_________|__________|__________|___________|__________|___________|______________"
Next i
Mx = 0
My = 0
Mp = 0
E = 0
F = 0
For i = N0 + 1 To Np
Mx = Mx + Point(i).Mx
My = My + Point(i).My
Mp = Mp + Point(i).Mp
E = E + Point(i).E
F = F + Point(i).F
Next i
Mx = Mx / (Np - N0)
My = My / (Np - N0)
Mp = Mp / (Np - N0)
E = E / (Np - N0)
F = F / (Np - N0)
Print #2, ""
Print #2, "Mx 的平均值="; Mx; Spc(2); "My 的平均值="; My; Spc(2); "Mp 的平均值="; Mp; Spc(2); "E 的平均值="; E; Spc(2); "F 的平均值="; F
Mx = Point(N0 + 1).Mx
For i = N0 + 1 To Np
If Mx < Point(i).Mx Then
Mx = Point(i).Mx
End If
Next i
My = Point(N0 + 1).My
For i = N0 + 1 To Np
If My < Point(i).My Then
My = Point(i).My
End If
Next i
Mp = Point(N0 + 1).Mp
For i = N0 + 1 To Np
If Mp < Point(i).Mp Then
Mp = Point(i).Mp
End If
Next i
E = Point(N0 + 1).Mp
For i = N0 + 1 To Np
If E < Point(i).E Then
E = Point(i).E
End If
Next i
Print #2, ""
Print #2, "Mx 的最大值="; Mx; Spc(2); "My 的最大值="; My; Spc(2); "Mp 的最大值="; Mp; Spc(2); "E 的最大值="; E
Print #2, ""
Print #2, "______________________________________________________________________________________"
Print #2, " 点号 方位角误差 边长误差 边长相对中误差 多余观测分量 点 号"
Print #2, "--------------------------------------------------------------------------------------"
Print #2, " | Mt | Ms | | Rx | Ry | Ri |"
Print #2, " | (s) | (cm) | | | | | "
Print #2, "--------------------------------------------------------------------------------------"
For i = 1 To N
Call PST(BaseLine(i).Mh, BaseLine(i).Nk)
s = Int(s / (BaseLine(i).Ms / 100) / 100#) * 100#
Print #2, Tab(3); Format(BaseLine(i).Mh, "000"); Tab(8); "|"; Tab(13); Format(BaseLine(i).Mt, "#0.#0"); Tab(20); "|"; Tab(26); Format(BaseLine(i).Ms, "0.##0"); Tab(33); "|"; Tab(37); _
"1:"; Format(s, "######0."); Tab(50); "|"; Tab(52); Format(BaseLine(i).R(1), "0.000"); Tab(58); "|"; Tab(60); _
Format(BaseLine(i).R(3), "0.000"); Tab(67); "|"; Tab(69); Format(BaseLine(i).R(1) + BaseLine(i).R(3), "0.000"); Tab(75); "|"; Tab(77); Format(BaseLine(i).Nk, "000")
Print #2, "_______|___________|____________|________________|_______|________|_______|___________ "
Next i
Print #2, ""
Print #2, "多余观测总数 R="; Format(R, "0.0000")
Mx = 0
My = 0
For i = 1 To N
Mx = Mx + BaseLine(i).Mt
My = My + BaseLine(i).Ms
Next i
Mx = Mx / N
My = My / N
Mp = R / (2 * N)
Print #2, ""
Print #2, "平均方位中误差="; Mx; Spc(2); "平均边长中误差="; My; Spc(2); "平均多余观测数="; Mp
Mx = BaseLine(1).Mt
For i = 1 To N
If Mx < BaseLine(i).Mt Then
Mx = BaseLine(i).Mt
End If
Next i
My = BaseLine(1).Ms
Call PST(BaseLine(1).Mh, BaseLine(1).Nk)
My = s / (My / 100)
For i = 1 To N
Mp = BaseLine(i).Ms
Call PST(BaseLine(i).Mh, BaseLine(i).Nk)
s = s / (Mp / 100)
If My > s Then
My = s
End If
Next i
Mp = BaseLine(1).R(1)
For i = 1 To N
If Mp > BaseLine(i).R(1) Then
Mp = BaseLine(i).R(1)
End If
If Mp > BaseLine(i).R(3) Then
Mp = BaseLine(i).R(3)
End If
Next i
Print #2, ""
Print #2, "最大方位误差="; Mx; Spc(2); "最弱边相对中误差=1:"; My; Spc(2); "多余观测最小值="; Mp
End Sub
'绘图
Public Sub Jdfbt(t As Integer)
Dim i%, j%, k%, NZ%, Xmax As Single, Ymax As Single, Xmin As Single, Ymin As Single
Dim X01, Y0, Bl, bl1, YY, XX, XX1, YY1, x1, y1, X2, Y2, X3, Y3
Open Fp3 For Output As #3
NZ = Np - N0
For i = 1 To Np
If Point(i).ID > N0 Then
et1(i) = Point(i).Et * Pi / 180
End If
Next i
For i = 1 To Np
x1 = Point(i).Y
y1 = Point(i).X + 2# * wtbl / 1000#
X2 = Point(i).Y + Sqr(3#) * wtbl / 1000#
Y2 = Point(i).X - wtbl / 1000#
X3 = Point(i).Y - 4# / Sqr(3) * wtbl / 1000#
Y3 = Point(i).X - wtbl / 1000#
Print #3, "line "; Format(x1, "#######"); ","; Format(y1, "#######"); Spc(1); _
Format(X2, "#######"); ","; Format(Y2, "#######"); Spc(1); Format(X3, "#######"); ","; Format(Y3, "#######"); Spc(1); "c"
Print #3, "point "; Format(Point(i).Y, "#######"); ","; Format(Point(i).X, "#######")
Next i
For i = 1 To N
Print #3, "line "; Format(Point(BaseLine(i).Nk).Y, "#.00"); ","; Format(Point(BaseLine(i).Nk).X, "#.00"); Spc(1); _
Format(Point(BaseLine(i).Mh).Y, "#.00"); ","; Format(Point(BaseLine(i).Mh).X, "#.00"); Spc(1)
Next i
Print #3, "layer"; Spc(1); "m"; Spc(1); "zj"; Spc(1); "c"; Spc(1); "red"; Spc(1); "zj"; Spc(1)
For i = 1 To Np
x1 = Point(i).X + 5 * wtbl / 1000#
y1 = 2 * wtbl / 1000#
Print #3, "text c"; Spc(1); Format(Point(i).Y, "#######"); ","; Format(x1, "#######"); Spc(1); Format(y1, "#######"); Spc(1); "20"; Spc(1); "0"; Spc(1); Point(i).Name
Next i
If t = 1 Then
Print #3, "layer"; Spc(1); "m"; Spc(1); "ty"; Spc(1); "c"; Spc(1); "green"; Spc(1); "ty"; Spc(1)
For k = N0 + 1 To Np
x1 = Point(k).E * wtbl * 0.01 / tybl * Cos(et1(k)) + Point(k).X
y1 = Point(k).E * wtbl * 0.01 / tybl * Sin(et1(k)) + Point(k).Y
Print #3, "ellipse c "; Format(Point(k).Y, "#.00"); ","; Format(Point(k).X, "#.00"); Spc(1); Format(y1, "#.00"); ","; _
Format(x1, "#.00"); Spc(1); Format(Point(k).F * 0.01 * wtbl / tybl, "#0.000") 'Format(Y2, "########"); ","; Format(X2, "#######")
Next k
End If
Print #3, "zoom e"; Spc(1)
Close #3
End Sub
'绘制误差椭圆
Public Sub hwcty(object As PictureBox, Bl As Double, bl1 As Integer)
Dim i%, j%
Dim b0 As Double
Dim x1 As Double, X2 As Double, y1 As Double, Y2 As Double
Dim mousep As Integer
mousep = object.MousePointer
object.MousePointer = 11
object.DrawMode = 13
object.AutoRedraw = False
For i = N0 + 1 To Np
For j = 1 To 1000
b0 = j * 8 / 1000
X2 = Point(i).Y + Point(i).F * Bl * 567 / bl1 * Cos(Pi - Point(i).Et * Pi / 180) * Cos(Pi - b0) - Point(i).F * Bl * 567 / bl1 * Sin(Pi - b0) * Sin(Pi - Point(i).Et * Pi / 180)
Y2 = Point(i).X + Point(i).E * Bl * 567 / bl1 * Sin(Pi - b0) * Cos(Pi - Point(i).Et * Pi / 180) - Point(i).E * Bl * 567 / bl1 * Cos(Pi - b0) * Sin(Pi - Point(i).Et * Pi / 180)
If j = 1 Then x1 = X2: y1 = Y2
object.Line (x1, y1)-(X2, Y2), RGB(0, 255, 0)
x1 = X2: y1 = Y2
Next j
Next i
object.AutoRedraw = True
object.MousePointer = mousep
End Sub
'显示点位误差
Public Sub xdwwc(dh As Integer)
Dim dwc As frmdjd
Set dwc = New frmdjd
With dwc
.Labeldh = "点号：" & Format(Point(dh).ID, "000")
.Labeldm = "点名：" & Point(dh).Name
.Labelx = "X：" & Format(Point(dh).X, "#.000")
.Labely = "Y：" & Format(Point(dh).Y, "#.000")
.Labelmx = "MX：" & Format(Point(dh).Mx, "#0.000") & "(cm)"
.Labelmy = "MY：" & Format(Point(dh).My, "#0.000") & "(cm)"
.Labelmp = "MP：" & Format(Point(dh).Mp, "#0.000") & "(cm)"
.Labele = "E：" & Format(Point(dh).E, "#0.000") & "(cm)"
.Labelf = "F：" & Format(Point(dh).F, "#0.000") & "(cm)"
.Labelet = "ET：" & Format(Point(dh).Et, "#0.000") & "(度)"
.Show 1
End With
End Sub
'显示基线精度
Public Sub xjxjd(bh As Integer)
Dim jxjd As frmjxjd
Dim s1 As Single
Set jxjd = New frmjxjd
Call PST(BaseLine(bh).Mh, BaseLine(bh).Nk)
s1 = Int(s / (BaseLine(bh).Ms / 100) / 100#) * 100#
Call DMS(t, fwd, fwf, fwm)
With jxjd
.Labelddh = "基线端点名称(1)：" & Point(BaseLine(bh).Nk).Name
.Labelddh1 = "基线端点名称(2)：" & Point(BaseLine(bh).Mh).Name
.Labelfwj = "基线方位角:" & Str(fwd) & Space(1) & Format(fwf, "00") & Space(1) & Format(fwm, "#.00")
.Labelbc = "基线边长：" & Format(s, "#.000") & "(米)"
.Labelms = "边长相对中误差:" & "1:" & Format(s1, "######0.")
.Labelmt = "方位角中误差(Mt):" & Format(BaseLine(bh).Mt, "#0.00") & "(秒)"
.Show 1
End With
End Sub
Private Sub DMS(a As Double, ID As Integer, IM As Integer, FS As Double)
Dim B As Double
a = 180# / Pi * a
ID = Int(a)
B = (a - ID) * 60
IM = Int(B)
FS = (B - IM) * 60
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -