📄 adjust.bas
字号:
Next I
Set arecord = g_d_Base.OpenRecordset("AdjustmentBasicInformationTable", dbOpenTable)
With arecord
.MoveFirst
.Edit
.Fields(21) = Int(PQ(2) * 100 + 0.5) / 100#
.Fields(22) = Int(PQ(2) / g_M2 * 100 + 0.5) / 100#
.Update
End With
arecord.Close
Set arecord = g_d_Base.OpenRecordset("DirectionAdjustedResultTable", dbOpenTable)
With arecord
ic = .RecordCount
If .RecordCount > 0 Then
.MoveFirst
For I = 1 To ic
.Delete
If I < ic Then
.MoveFirst
End If
Next I
End If
For I = 1 To g_M2
If (PQVV(I) < 0.00001) Then
WA = 0
Else
t = Sqr(PQVV(I)) * UW
WA = V2(I) / t
End If
If Abs(WA) > Ka Then
MsgBox "Horinzontal Direction Observation Value from " + Trim(g_PN(G(I))) + " To " + Trim(g_PN(F(I))) + " Maybe contain Gross Error !", , "Information"
ZT2 = ZT2 + 1
End If
t2 = g_Dir1(I)
T3 = UW * Sqr(QLL(I))
Call WG(t2, g_Kg)
Call WG(g_Dir(I), g_Kg)
If (YU = 1) Then
g_Dir1(I) = 0#
t1 = 0#
t2 = 0#
V2(I) = 0#
WA = 0#
End If
.AddNew
.Fields(0) = I
.Fields(1) = G1(I)
.Fields(2) = F1(I)
.Fields(3) = Int(g_Dir(I) * 1000000#) / 1000000#
.Fields(4) = Int(V2(I) * 100 + 0.5) / 100#
.Fields(5) = Int(t2 * 1000000#) / 1000000#
.Fields(6) = Int(T3 * 100 + 0.5) / 100#
.Fields(7) = Int(PQVV(I) * 100 + 0.5) / 100#
.Fields(8) = Int(Abs(WA) * 100 + 0.5) / 100#
.Update
Next I
End With
arecord.Close
End If
If (YU = 1) Then GoTo LLLLLLL
If (M > 0 And g_Net <= 5) Then
PVV1 = PVVI(1) + PVVI(2)
UW1 = Sqr(PVV1 / (PQ(1) + PQ(2)))
M02(5) = UW1
Else
UW1 = M02(5)
End If
LLLLLLL:
End Sub
Sub AdjXYZ()
Dim Zt As Long
Dim Zt1 As Long
Zt = 2 * g_Ed
Zt1 = Zt
For I = 1 To Zt1
DXYZ(I) = 0#
Next I
For I = 1 To N
DXYZ(Zt1 + I) = 0#
DI = (I - 1) * (N - I / 2#)
For j = 1 To N
DJ = (j - 1) * (N - j / 2#)
If (j < I) Then
DXYZ(I + Zt1) = DXYZ(I + Zt1) - C(DJ + I) * W(j)
Else
DXYZ(I + Zt1) = DXYZ(I + Zt1) - C(DI + j) * W(j)
End If
Next j
Next I
If (g_Net < 6) Then
PVV = 0#
For I = 1 To N
PVV = PVV + W(I) * DXYZ(I + Zt1)
Next I
PVV = PVV + Pll
UW = Sqr(PVV / (M * 1#))
End If
End Sub
Sub AdjXyz1()
Dim h As Long
Dim Ta As Double
Dim Tb As Double
Dim vx(g_MaxPotNum) As Double
Dim vy(g_MaxPotNum) As Double
Dim vz(g_MaxPotNum) As Double
g_Sd = g_Ed + g_Dd
k = 2 * g_Sd
For I = 1 To k
DXYZ(I) = DXYZ(I) / 1000#
Next I
For I = 1 To g_Sd
j = 2 * I - 1
x(I) = X0(I) + DXYZ(j)
y(I) = Y0(I) + DXYZ(j + 1)
vx(I) = DXYZ(j) * 1000
vy(I) = DXYZ(j + 1) * 1000
Next I
For I = 1 To k
DXYZ(I) = DXYZ(I) * 1000#
Next I
Set arecord = g_d_Base.OpenRecordset("CoordinateAdjustedResultTable", dbOpenTable)
With arecord
ic = .RecordCount
If .RecordCount > 0 Then
.MoveFirst
For I = 1 To ic
.Delete
If I < ic Then
.MoveFirst
End If
Next I
End If
For I = 1 To g_Sd
.AddNew
.Fields(0) = I
.Fields(1) = g_PN(I)
.Fields(2) = Int(x(I) * 100000# + 0.5) / 100000#
.Fields(3) = Int(y(I) * 100000# + 0.5) / 100000#
.Fields(4) = Int(vx(I) * 100# + 0.5) / 100#
.Fields(5) = Int(vy(I) * 100# + 0.5) / 100#
.Update
Next I
End With
arecord.Close
End Sub
Sub ELLIPODE()
Dim L01 As Double
Dim L02 As Double
Dim Q(6) As Double
Dim t(9) As Double
Dim FI1(3, 3) As Double
Dim MX1 As Double
Dim MY1 As Double
Dim MZ1 As Double
Dim MP1 As Double
Dim MX As Double
Dim MY As Double
Dim MZ As Double
Dim x As Double
Dim y As Double
Dim Z As Double
Dim MP As Double
Dim FI As Double
Dim JJ(3) As Long
Dim h As Long
Dim DII(3) As Long
Dim DJJ(3) As Long
Dim ii(3) As Long
Dim L1 As Long
Dim L2 As Long
Dim I As Long
Dim j As Long
Dim k As Long
Dim L As Long
If (g_Kg = 1) Then
L01 = 180
L02 = 57.29577951
Else
L01 = 200
L02 = 63.66197724
End If
L2 = g_Ed
L1 = g_Dd
g_Sd = g_Ed + g_Dd
Set arecord = g_d_Base.OpenRecordset("CoordinateAdjustedResultTable", dbOpenTable)
With arecord
.MoveFirst
For I = 1 To L1 + L2
If I <= L2 Then
MX = 0
MY = 0
MP = 0
GoTo LL
End If
DI = (2 * I - 2) * (N - (2 * I - 2 + 1) / 2#)
DJ = (2 * I - 2 + 1) * (N - (2 * I - 2 + 2) / 2#)
Q(1) = C(DI + 2 * I - 2 + 1)
Q(2) = C(DJ + 2 * I - 2 + 2)
Q(3) = C(DI + 2 * I - 2 + 2)
x = Q(1) - Q(2)
y = 2# * Q(3)
Z = Q(1) + Q(2)
MX1 = Sqr(Q(1))
MY1 = Sqr(Q(2))
MX = UW * MX1
MY = UW * MY1
MP = Sqr(MX ^ 2 + MY ^ 2)
If (Abs(x) < 0.0000000001) Then
FI = L01 / 2 * Q(3) / Abs(Q(3))
Else
FI = Atn(y / x) * L02
End If
If (x >= 0) Then
If (y >= 0) Then
FI = FI / 2#
Else
FI = (L01 * 2 + FI) / 2#
End If
Else
FI = (FI + L01) / 2#
End If
W1 = Sqr(x * x + y * y)
t(1) = Sqr((Z + W1) / 2#)
If Abs(Z - W1) < 0.0000000000001 Then
t(2) = 0
Else
t(2) = Sqr((Z - W1) / 2#)
End If
t(3) = UW * t(1)
t(4) = UW * t(2)
.Edit
.Fields(6) = Int(MX * 100 + 0.5) / 100#
.Fields(7) = Int(MY * 100 + 0.5) / 100#
.Fields(8) = Int(MP * 100 + 0.5) / 100#
.Fields(9) = Int(t(3) * 100 + 0.5) / 100#
.Fields(10) = Int(t(4) * 100 + 0.5) / 100#
.Fields(11) = Int(FI * 100 + 0.5) / 100#
.Update
LL:
If I < L1 + L2 Then
.MoveNext
End If
Next I
End With
arecord.Close
If (g_Co > 0) Then
Set arecord = g_d_Base.OpenRecordset("RelativeEllipsoidResultTable", dbOpenTable)
With arecord
ic = .RecordCount
If .RecordCount > 0 Then
.MoveFirst
For I = 1 To ic
.Delete
If I < ic Then
.MoveFirst
End If
Next I
End If
For h = 1 To g_Co
For L = 1 To 2
ii(L) = 2 * RT(h) - 2 + L
JJ(L) = 2 * TT(h) - 2 + L
DII(L) = (ii(L) - 1) * (N - ii(L) / 2#)
DJJ(L) = (JJ(L) - 1) * (N - JJ(L) / 2#)
Next L
For I = 1 To 2
DI = (I - 1) * (2 - I / 2#)
For j = I To 2
Q(DI + j) = C(DII(I) + ii(j)) + C(DJJ(I) + JJ(j)) - C(DII(I) + JJ(j)) - C(DII(j) + JJ(I))
Next j
Next I
.AddNew
x = Q(1) - Q(3)
y = 2# * Q(2)
Z = Q(1) + Q(3)
MX1 = Sqr(Q(1))
MY1 = Sqr(Q(3))
MP1 = Sqr(Z)
MX = UW * MX1
MY = UW * MY1
MP = UW * MP1
If (Abs(x) < 0.0000000001) Then
FI = L01 / 2 * Q(3) / Abs(Q(3))
Else
FI = Atn(y / x) * L02
End If
If (x >= 0) Then
If (y >= 0) Then
FI = FI / 2#
Else
FI = (2 * L01 + FI) / 2#
End If
Else
FI = (FI + L01) / 2#
End If
W1 = Sqr(x * x + y * y)
t(1) = Sqr((Z + W1) / 2#)
t(2) = Sqr((Z - W1) / 2#)
t(3) = UW * t(1)
t(4) = UW * t(2)
.Fields(0) = h
.Fields(1) = g_PN(RT(h))
.Fields(2) = g_PN(TT(h))
.Fields(3) = Int(MX * 100 + 0.5) / 100#
.Fields(4) = Int(MY * 100 + 0.5) / 100#
.Fields(5) = Int(MP * 100 + 0.5) / 100#
.Fields(6) = Int(t(3) * 100 + 0.5) / 100#
.Fields(7) = Int(t(4) * 100 + 0.5) / 100#
.Fields(8) = Int(FI * 100 + 0.5) / 100#
.Update
Next h
End With
arecord.Close
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -