前后方交会三维坐标计算运行主窗口.frm

摄影测量影象匹配

Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""

End Sub

Private Sub Command5_Click()
Form1.Hide
Form2.Show
End Sub

Private Sub Command1_Click()
interdir.Enabled = False
Frame6.Enabled = False
Frame1.Enabled = True
Frame5.Enabled = True
Frame2.Enabled = False
End Sub

Private Sub Command2_Click()

outfactor.Enabled = False
Frame1.Enabled = False
Frame5.Enabled = False
Frame2.Enabled = True


End Sub

Private Sub convert_Click()

Dim n As Integer, X() As Double, Y() As Double
Dim a(6, 1) As Double, k As Integer
Dim xz() As Double, yz() As Double
Dim i As Integer

If Option1.Value = True Then
n = InputBox("输入需要转化的像点坐标的个数第一张")
ReDim X(n)
ReDim Y(n)
Open "相片坐标1.txt " For Input As #1
For i = 1 To n
Input #1, X(i)
Input #1, Y(i)
Next i
Close #1
ElseIf Option2.Value = True Then
n = InputBox("输入需要转化的像点坐标的个数第二张")
ReDim X(n)
ReDim Y(n)
Open "相片坐标2.txt " For Input As #1
For i = 1 To n
Input #1, X(i)
Input #1, Y(i)
Next i
Close #1
Else
k = 0
End If
ReDim xz(n) As Double
ReDim yz(n) As Double
Open "变换参数.txt" For Input As #1
For i = 1 To 6
Input #1, a(i, 1)
Next i
Close #1

For i = 1 To n

xz(i) = a(1, 1) + a(2, 1) * X(i) + a(3, 1) * Y(i)
yz(i) = a(4, 1) + a(5, 1) * X(i) + a(6, 1) * Y(i)
Next i

If Option1.Value = True Then
Open "相片坐标1.txt " For Output As #1
For i = 1 To n
Print #1, xz(i), yz(i)
Next i
Close #1

ElseIf Option2.Value = True Then
Open "相片坐标2.txt " For Output As #1
For i = 1 To n
Print #1, xz(i), yz(i)
Next i
Close #1
Else
k = 0
End If
MsgBox ("已经转换完毕")

End Sub

Private Sub end_Click()
End
End Sub




Private Sub forwardintersect_Click()
Dim i As Integer, xdm As Double, ydm As Double, zdm As Double
Dim n1 As Double, n2 As Double
Dim xs1 As Double, ys1 As Double, zs1 As Double, q1 As Double, w1 As Double, k1 As Double
Dim xs2 As Double, ys2 As Double, zs2 As Double, q2 As Double, w2 As Double, k2 As Double
Dim n As Integer
Dim r1(3, 3) As Double, r2(3, 3) As Double
Dim xip1() As Double, xip2() As Double
Dim xkf1() As Double, xkf2() As Double
Dim bx As Double, by As Double
Dim f1 As Double, j As Integer
Dim chishidu As String             '读数据时候的过渡变量
Dim dianhao As Integer             '读入的同名点的点号

f1 = InputBox("输入进行前方交会运算所用到相片焦距的值 单位为米")

Open "结算的点的控制坐标.txt" For Output As #2
Print #2, 结算出来的各个同名点在测量坐标系中的三维坐标的数值
Print #2, "ID", "X", Space(7), "Y", Space(7), "Z"
Close #2

n = InputBox("输入结算的点的个数")
Open "外方位1.txt" For Input As #1
Line Input #1, ch
xs1 = Left(ch, 30)
Line Input #1, ch
ys1 = Left(ch, 30)
Line Input #1, ch
zs1 = Left(ch, 30)
Line Input #1, ch
q1 = Left(ch, 30)
Line Input #1, ch
w1 = Left(ch, 30)
Line Input #1, ch
k1 = Left(ch, 30)
Close #1

Open "外方位2.txt" For Input As #1
Line Input #1, ch
xs2 = Left(ch, 30)
Line Input #1, ch
ys2 = Left(ch, 30)
Line Input #1, ch
zs2 = Left(ch, 30)
Line Input #1, ch
q2 = Left(ch, 30)
Line Input #1, ch
w2 = Left(ch, 30)
Line Input #1, ch
k2 = Left(ch, 30)
Close #1



r1(1, 1) = Cos(q1) * Cos(k1) - Sin(q1) * Sin(w1) * Sin(k1): r1(1, 2) = -Cos(q1) * Sin(k1) - Sin(q1) * Sin(w1) * Cos(k1): r1(1, 3) = -Sin(q1) * Cos(w1)
r1(2, 1) = Cos(w1) * Sin(k1): r1(2, 2) = Cos(w1) * Cos(k1): r1(2, 3) = -Sin(w1)
r1(3, 1) = Sin(q1) * Cos(k1) + Cos(q1) * Sin(w1) * Sin(k1): r1(3, 2) = -Sin(q1) * Sin(k1) + Cos(q1) * Sin(w1) * Cos(k1): r1(3, 3) = Cos(q1) * Cos(w1)


r2(1, 1) = Cos(q2) * Cos(k2) - Sin(q2) * Sin(w2) * Sin(k2): r2(1, 2) = -Cos(q2) * Sin(k2) - Sin(q2) * Sin(w2) * Cos(k2): r2(1, 3) = -Sin(q2) * Cos(w2)
r2(2, 1) = Cos(w2) * Sin(k2): r2(2, 2) = Cos(w2) * Cos(k2): r2(2, 3) = -Sin(w2)
r2(3, 1) = Sin(q2) * Cos(k2) + Cos(q2) * Sin(w2) * Sin(k2): r2(3, 2) = -Sin(q2) * Sin(k2) + Cos(q2) * Sin(w2) * Cos(k2): r2(3, 3) = Cos(q2) * Cos(w2)

bx = xs2 - xs1
by = ys2 - ys1
bz = zs2 - zs1
j = 1


Open "同名点坐标.txt" For Input As #1

Line Input #1, chishidu
Line Input #1, chishidu


For i = 1 To n

Line Input #1, chishidu

ReDim xip1(3, 1)
ReDim xip2(3, 1)
Line Input #1, chishidu
Input #1, dianhao
Input #1, xip1(1, 1)
Input #1, xip1(2, 1)
xip1(3, 1) = -f1

Line Input #1, chishidu
Input #1, dianhao
Input #1, xip2(1, 1)
Input #1, xip2(2, 1)
xip2(3, 1) = -f1
ReDim xkf1(3, 1)
ReDim xkf2(3, 1)
Call MMul(3, 3, 1, r1(), xip1(), xkf1())
Call MMul(3, 3, 1, r2(), xip2(), xkf2())

n1 = (bx * xkf2(3, 1) - bz * xkf2(1, 1)) / (xkf1(1, 1) * xkf2(3, 1) - xkf1(3, 1) * xkf2(1, 1))

n2 = (bx * xkf1(3, 1) - bz * xkf1(1, 1)) / (xkf1(1, 1) * xkf2(3, 1) - xkf1(3, 1) * xkf2(1, 1))

xdm = xs1 + n1 * xkf1(1, 1)
ydm = ys1 + 0.5 * (n1 * xkf1(2, 1) + n2 * xkf2(2, 1) + by)
zdm = zs1 + n1 * xkf1(3, 1)

Open "结算的点的控制坐标.txt" For Append As #2
Print #2, dianhao, xdm, Space(7), ydm, Space(7), zdm
Close #2
Next i
Close #1
MsgBox ("已经求好")

forwardintersect.Enabled = False
End Sub

Private Sub outfactor_Click()
Dim nk As Integer, xd() As Double, yd() As Double, zd() As Double
Dim xp() As Double, yp() As Double, zp() As Double
Dim j2 As Integer, j3 As Integer
Dim i As Integer, n1 As Integer, d() As Double, m() As Double
Dim m1 As Double, h As Double, d1() As Double
Dim X() As Double, Y() As Double
Dim f As Double, j As Integer, j1 As Integer
Dim xj() As Double, yj() As Double, lj() As Double
Dim zs() As Double, xs() As Double, ys() As Double, q() As Double, w() As Double, k() As Double
Dim a() As Double, imin As Integer, r1 As Integer
Dim t1 As Double, t2 As Double, t3 As Double, t4 As Double, t5 As Double
Dim q1 As Integer
Dim mtxAt() As Double, mtxC() As Double, mjn() As Double, jzx() As Double
Dim zd1 As Double, xd1 As Double, yd1 As Double
Dim ls() As Double
Dim chs As Integer
Dim bzh As Integer
Dim count As Integer
Dim lab1 As Double, lab2 As Double, lab3 As Double
Dim ch As String

j2 = 1
ReDim Preserve zs(j2)
ReDim Preserve ys(j2)
ReDim Preserve xs(j2)
ReDim Preserve q(j2)
ReDim Preserve w(j2)
ReDim Preserve k(j2)
nk = Val(Text1.Text)
f = Val(Text2.Text)
ReDim Preserve xd(nk)
ReDim Preserve yd(nk)
ReDim Preserve zd(nk)
ReDim Preserve X(nk)
ReDim Preserve Y(nk)
bzh = InputBox("输入求解外方位元素的相片号  1 为第一张相片 2 为第二张相片")


If bzh = 1 Then
Label6.Caption = "第一个相片后方交会迭代结束时三个角度的改正量"

Open "地面控制点1.txt " For Input As #1
Line Input #1, ch

For i = 1 To nk
Input #1, xd(i)
Input #1, yd(i)
Input #1, zd(i)
Next i
Close #1

Open "相片坐标1.txt " For Input As #1
For i = 1 To nk
Input #1, X(i)
Input #1, Y(i)
Next i
Close #1
Else

Label6.Caption = "第二个相片后方交会迭代结束时三个角度的改正量"

Open "地面控制点2.txt " For Input As #1
Line Input #1, ch
For i = 1 To nk
Input #1, xd(i)
Input #1, yd(i)
Input #1, zd(i)
Next i
Close #1

Open "相片坐标2.txt " For Input As #1

For i = 1 To nk
Input #1, X(i)
Input #1, Y(i)
Next i
Close #1
End If

 For i = 1 To nk - 1
imin = i
For r1 = i + 1 To nk
If zd(r1) < zd(imin) Then imin = r1
Next r1
t1 = zd(i): zd(i) = zd(imin): zd(imin) = t1
t2 = yd(i): yd(i) = yd(imin): yd(imin) = t2
t3 = xd(i): xd(i) = xd(imin): xd(imin) = t3
t4 = X(i): X(i) = X(imin): X(imin) = t4
t5 = Y(i): Y(i) = Y(imin): Y(imin) = t5
Next i

 If nk Mod 2 = 0 Then
 n1 = nk
 Else
 n1 = nk - 1
 End If
 For i = 1 To n1 Step 2
 q1 = q1 + 1
 ReDim Preserve d(q1)
 ReDim Preserve d1(q1)
d(q1) = ((xd(i) - xd(i + 1)) ^ 2 + (yd(i) - yd(i + 1)) ^ 2) ^ (1 / 2)
d1(q1) = ((X(i) - X(i + 1)) ^ 2 + (Y(i) - Y(i + 1)) ^ 2) ^ (1 / 2)
Next i

For i = 1 To q1
ReDim Preserve m(i)
m(i) = d(i) / d1(i)
m1 = m1 + m(i)
Next i
m1 = m1 / q1
h = m1 * f
ReDim a(2 * nk, 6)

For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 1) = 0
Else
a(j, 1) = -1 * f / h
End If
Next j

For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 2) = -1 * f / h
Else
a(j, 2) = 0
End If
Next j

j1 = 1
For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 3) = -1 * Y(j1) / h
Else
a(j, 3) = -1 * X(j1) / h
End If
If j Mod 2 = 0 Then
j1 = j1 + 1
End If
Next j

j1 = 1
For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 4) = -1 * X(j1) * Y(j1) / f
Else
a(j, 4) = -1 * f * (1 + X(j1) ^ 2 / f ^ 2)
End If
If j Mod 2 = 0 Then
j1 = j1 + 1
End If
Next j

j1 = 1
For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 5) = -1 * f * (1 + Y(j1) ^ 2 / f ^ 2)
Else
a(j, 5) = -1 * X(j1) * Y(j1) / f
End If
If j Mod 2 = 0 Then
j1 = j1 + 1
End If
Next j

j1 = 1
For j = 1 To 2 * nk
If j Mod 2 = 0 Then
a(j, 6) = -X(j1)
Else
a(j, 6) = Y(j1)
End If
If j Mod 2 = 0 Then
j1 = j1 + 1
End If
Next j

ReDim Preserve mtxAt(6, 2 * nk) '求转置距阵
Call MTrans(2 * nk, 6, a(), mtxAt())

ReDim mtxC(6, 6)                              '求距阵的乘法
Call MMul(6, 2 * nk, 6, mtxAt(), a(), mtxC())

ReDim mjn(6, 6)                      '求距阵的求逆
For i = 1 To 6
 For j = 1 To 6
 mjn(i, j) = mtxC(i, j)
Next j
Next i
Call MRinv(6, mjn())

ReDim jzx(6, 2 * nk)                            '求距阵的乘法
Call MMul(6, 6, 2 * nk, mjn(), mtxAt(), jzx())

For i = 1 To nk
zd1 = zd1 + zd(i)
xd1 = xd1 + xd(i)
yd1 = yd1 + yd(i)
Next i
zs(1) = zd1 / nk + m1 * f
xs(1) = xd1 / nk
ys(1) = yd1 / nk
q(1) = 0
k(1) = 0
w(1) = 0

 Do
ReDim xj(nk)
ReDim yj(nk)
For i = 1 To nk
xj(i) = -f * ((Cos(q(j2)) * Cos(k(j2)) - Sin(q(j2)) * Sin(w(j2)) * Sin(k(j2))) * (xd(i) - xs(j2)) + Cos(w(j2)) * Sin(k(j2)) * (yd(i) - ys(j2)) + (Sin(q(j2)) * Cos(k(j2)) + Cos(q(j2)) * Sin(w(j2)) * Sin(k(j2))) * (zd(i) - zs(j2))) / (-Sin(q(j2)) * Cos(w(j2)) * (xd(i) - xs(j2)) - Sin(w(j2)) * (yd(i) - ys(j2)) + Cos(q(j2)) * Cos(w(j2)) * (zd(i) - zs(j2)))

yj(i) = -f * ((-Cos(q(j2)) * Sin(k(j2)) - Sin(q(j2)) * Sin(w(j2)) * Cos(k(j2))) * (xd(i) - xs(j2)) + Cos(w(j2)) * Cos(k(j2)) * (yd(i) - ys(j2)) + (-Sin(q(j2)) * Sin(k(j2)) + Cos(q(j2)) * Sin(w(j2)) * Cos(k(j2))) * (zd(i) - zs(j2))) / (-Sin(q(j2)) * Cos(w(j2)) * (xd(i) - xs(j2)) - Sin(w(j2)) * (yd(i) - ys(j2)) + Cos(q(j2)) * Cos(w(j2)) * (zd(i) - zs(j2)))
Next i
ReDim lj(2 * nk, 1)
For i = 1 To nk
j3 = j3 + 1
lj(j3, 1) = X(i) - xj(i)
j3 = j3 + 1
lj(j3, 1) = Y(i) - yj(i)
Next i
ReDim ls(6, 1)
Call MMul(6, 2 * nk, 1, jzx(), lj(), ls())

If Abs(ls(4, 1)) > 2 * 3.1415926 Then
If ls(4, 1) >= 2 * 3.1415926 Then
chs = Int(ls(4, 1) / (2 * 3.1415926))
ls(4, 1) = ls(4, 1) - chs * 2 * 3.1415926
Else
chs = Int(ls(4, 1) / (-2 * 3.1415926))
ls(4, 1) = ls(4, 1) + chs * 2 * 3.1415926
End If
End If

If Abs(ls(5, 1)) > 2 * 3.1415926 Then
If ls(5, 1) >= 2 * 3.1415926 Then
chs = Int(ls(5, 1) / (2 * 3.1415926))
ls(5, 1) = ls(5, 1) - chs * 2 * 3.1415926
Else
chs = Int(ls(5, 1) / (-2 * 3.1415926))
ls(5, 1) = ls(5, 1) + chs * 2 * 3.1415926
End If
End If

If Abs(ls(6, 1)) > 2 * 3.1415926 Then
If ls(6, 1) >= 2 * 3.1415926 Then
chs = Int(ls(6, 1) / (2 * 3.1415926))
ls(6, 1) = ls(6, 1) - chs * 2 * 3.1415926
Else
chs = Int(ls(6, 1) / (-2 * 3.1415926))
ls(6, 1) = ls(6, 1) + chs * 2 * 3.1415926
End If
End If

j2 = j2 + 1
ReDim Preserve zs(j2)
ReDim Preserve ys(j2)
ReDim Preserve xs(j2)
ReDim Preserve q(j2)
ReDim Preserve w(j2)
ReDim Preserve k(j2)

xs(j2) = xs(j2 - 1) + ls(1, 1)
ys(j2) = ys(j2 - 1) + ls(2, 1)
zs(j2) = zs(j2 - 1) + ls(3, 1)
q(j2) = q(j2 - 1) + ls(4, 1)
w(j2) = w(j2 - 1) + ls(5, 1)
k(j2) = k(j2 - 1) + ls(6, 1)
count = count + 1
If Abs(ls(4, 1)) <= 2 * 3.1415926 * 0.001 / (60 * 360) And Abs(ls(5, 1)) <= 2 * 3.1415926 * 0.001 / (60 * 360) And Abs(ls(6, 1)) <= 2 * 3.1415926 * 0.001 / (60 * 360) Then
Exit Do
Else
j3 = 0
End If
Loop
MsgBox ("已经求好外方位元素")
If bzh = 1 Then
Open "外方位1.txt" For Output As #1
Print #1, xs(j2)
Print #1, ys(j2)
Print #1, zs(j2)
Print #1, q(j2)
Print #1, w(j2)
Print #1, k(j2)
Close #1
Else
Open "外方位2.txt" For Output As #1
Print #1, xs(j2)
Print #1, ys(j2)
Print #1, zs(j2)
Print #1, q(j2)
Print #1, w(j2)
Print #1, k(j2)
Close #1
End If
lab1 = Format((ls(4, 1) / (2 * 3.1415926)) * 360 * 3600, "###.####")
lab2 = Format((ls(5, 1) / (2 * 3.1415926)) * 360 * 3600, "###.###")
lab3 = Format((ls(6, 1) / (2 * 3.1415926)) * 360 * 3600, "###.###")
Label8.Caption = count
Label12.Caption = lab1
Label13.Caption = lab2
Label14.Caption = lab3
End Sub


Private Sub returnmain_Click()
Form7.Hide
Form8.Show
End Sub



Private Sub Timer1_Timer()
If Label16.Left + Label16.Width > 0 Then
Label16.Move Label16.Left - 50
Else
Label16.Left = Form1.ScaleWidth
End If
End Sub