?? 空間后交.txt
字號:
Option Explicit
Dim m#, H# '航攝比例尺、航高
Dim x0, y0, f '內方位元素
Dim Xt#(1 To 4), Yt#(1 To 4), Zt#(1 To 4) '控制點地面測量坐標(控制測量得到)
Dim Xtp#(1 To 4), Ytp#(1 To 4), Ztp#(1 To 4) '控制點地面攝影測量坐標
Dim Xcl#(1 To 4), Ycl#(1 To 4), Xcr#(1 To 4), Ycr#(1 To 4) '控制點左片坐標和右片坐標
Dim n#, Xl#(), Yl#(), Xr#(), Yr#() '待測點像片坐標(立體量測得到)
Dim X#(), Y#(), Z#() '待測點地面測量坐標(前方交會結果)
Dim fai_L#, omg_L#, kap_L#, XsL#, YsL#, ZsL# '左片外方位元素
Dim fai_R#, omg_R#, kap_R#, XsR#, YsR#, ZsR# '左片外方位元素
Dim Bx#, By#, Bz# '基線分量
Dim R_L#(1 To 3, 1 To 3), R_R#(1 To 3, 1 To 3) '左右像片的旋轉矩陣
Const RU = 206265
'顯示“關于”窗體的過程
Private Sub mnuAbout_Click()
frmAbout.Show
End Sub
'輸入控制點地面坐標,供空間后方交會使用
Private Sub mnuInputGCP_Click()
Dim strTemp As String, dblTemp As Double
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "讀取已知數據"
CDg1.FileName = "": CDg1.Action = 1
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '讀第一行題頭信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp & vbCrLf
'讀入控制點地面坐標
Input #1, Xt(1), Yt(1), Zt(1)
Input #1, Xt(2), Yt(2), Zt(2)
Input #1, Xt(3), Yt(3), Zt(3)
Input #1, Xt(4), Yt(4), Zt(4)
'顯示讀入的控制點地面坐標
txtShow.Text = txtShow.Text & Xt(1) & " , " & Yt(1) & " , " & Zt(1) & vbCrLf
txtShow.Text = txtShow.Text & Xt(2) & " , " & Yt(2) & " , " & Zt(2) & vbCrLf
txtShow.Text = txtShow.Text & Xt(3) & " , " & Yt(3) & " , " & Zt(3) & vbCrLf
txtShow.Text = txtShow.Text & Xt(4) & " , " & Yt(4) & " , " & Zt(4) & vbCrLf
Close #1
End Sub
'輸入像片有關信息,供空間后方交會計算使用
Private Sub mnuInputInfo_Click()
Dim strTemp As String, dblTemp As Double
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "讀取已知數據"
CDg1.FileName = "": CDg1.Action = 1
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '讀第一行題頭信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp
Input #1, m, H '讀入航攝比例尺和航高
txtShow.Text = txtShow.Text & vbCrLf & "航攝比例尺1:" & m & " ,航高:" & H & vbCrLf
Input #1, x0, y0, f '讀入內定向元素
txtShow.Text = txtShow.Text & vbCrLf & "內方位元素" & x0 & y0 & f & vbCrLf
'讀入控制點像片坐標:暫存在左片有關數組里
Input #1, Xcl(1), Ycl(1), Xcl(2), Ycl(2), Xcl(3), Ycl(3), Xcl(4), Ycl(4)
txtShow.Text = txtShow.Text & Xcl(1) & " , " & Ycl(1) & vbCrLf
txtShow.Text = txtShow.Text & Xcl(2) & " , " & Ycl(2) & vbCrLf
txtShow.Text = txtShow.Text & Xcl(3) & " , " & Ycl(3) & vbCrLf
txtShow.Text = txtShow.Text & Xcl(4) & " , " & Ycl(4) & vbCrLf
Close #1
End Sub
'輸入左片方位元素
Private Sub mnuInputLeft_Click()
Dim strTemp As String, dblTemp As Double
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "讀取已知數據"
CDg1.FileName = "": CDg1.Action = 1
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '讀第一行題頭信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp & vbCrLf
Input #1, x0, y0, f '讀入內定向元素
txtShow.Text = txtShow.Text & "內方位元素" & x0 & y0 & f & vbCrLf
Input #1, fai_L, omg_L, kap_L '左片外方位元素的三個角元素
txtShow.Text = txtShow.Text & "左片外方位角元素" & fai_L & " , " & omg_L & " , " & kap_L & vbCrLf
Input #1, XsL, YsL, ZsL '左片外方位元素的三個線元素
txtShow.Text = txtShow.Text & "左片外方位線元素" & XsL & " , " & YsL & " , " & ZsL & vbCrLf
Close #1
End Sub
'輸入右片方位元素
Private Sub mnuInputRight_Click()
Dim strTemp As String, dblTemp As Double
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "讀取已知數據"
CDg1.FileName = "": CDg1.Action = 1
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '讀第一行題頭信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp & vbCrLf
Input #1, x0, y0, f '讀入內定向元素
txtShow.Text = txtShow.Text & "右片內方位元素" & x0 & y0 & f & vbCrLf
Input #1, fai_R, omg_R, kap_R '右片外方位元素的三個角元素
txtShow.Text = txtShow.Text & "右片外方位角元素" & fai_R & " , " & omg_R & " , " & kap_R & vbCrLf
Input #1, XsR, YsR, ZsR '右片外方位元素的三個線元素
txtShow.Text = txtShow.Text & "右片外方位線元素" & XsR & " , " & YsR & " , " & ZsR & vbCrLf
Close #1
End Sub
'保存空間后方交會計算結果,為空間前方交會提供數據:其中內方位元素轉錄自像片信息文件
Private Sub mnuSaveR_Click()
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "保存計算結果"
CDg1.FileName = "": CDg1.Action = 2
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Output As #1
Print #1, "像片的方位元素:"
Print #1, x0; ","; y0; ","; f
Print #1, fai_L; ","; omg_L; ","; kap_L; ","
Print #1, XsL; ","; YsL; ","; ZsL
Close #1
End Sub
'空間后方交會的計算過程
Private Sub mnuSpcResec_Click()
Dim i# '循環變量
'地面測量坐標-->地面攝影測量坐標:這里采用最簡單的方法,即原點不動,x,y互換
For i = 1 To 4
Xtp(i) = Yt(i): Ytp(i) = Xt(i): Ztp(i) = Zt(i)
Next i
'準備像片片未知數的初值
fai_L = 1: omg_L = 0: kap_L = 0
ZsL = m * f: XsL = 0: YsL = 0
For i = 1 To 4
XsL = XsL + Xtp(i): YsL = YsL + Ytp(i)
Next i
XsL = XsL / 4: YsL = YsL / 4
'調用后方交會過程求解像片片外方位元素
subSpaceResection fai_L, omg_L, kap_L, XsL, YsL, ZsL, Xcl, Ycl, 0.0004
'顯示計算結果
txtShow.Text = txtShow.Text & "空間后方交會結果:" & vbCrLf
txtShow.Text = txtShow.Text & "三個角元素:" & Str(fai_L) & " , " & Str(omg_L) & " , " & Str(kap_L) & vbCrLf
txtShow.Text = txtShow.Text & "三個線元素:" & Str(XsL) & " , " & Str(YsL) & " , " & Str(ZsL) & vbCrLf
End Sub
'退出程序的過程
Private Sub mnuExit_Click()
End
End Sub
'讀取待測點像片坐標
Private Sub mnuInput_Click()
Dim strTemp As String, dblTemp As Double
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "讀取已知數據"
CDg1.FileName = ""
CDg1.Action = 1
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '讀第一行題頭信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp
Input #1, n '讀入待測點個數
txtShow.Text = txtShow.Text & "待測點個數:" & n & vbCrLf
Dim i#
For i = 1 To n
Input #1, Xl(i), Yl(i), Xr(i), Yr(i)
txtShow.Text = txtShow.Text & Xl(i) & " , " & Yl(i) & Xr(i) & " , " & Yr(i) & vbCrLf
Next i
Close #1
Dim a0#, a1#, a2#, b0#, b1#, b2#, tempX#, tempY#
CDg1.Filter = "定向參數文件(*.io)|*.io|All Files(*.*)|*.*"
'輸入第一張像片的定向參數數據++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CDg1.DialogTitle = "讀取第一張像片的定向參數"
CDg1.FileName = "": CDg1.Action = 1
GetIO CDg1.FileName, a0, a1, a2, b0, b1, b2
'改化左片像點坐標
For i = 1 To n
tempX = Xl(i): tempY = Yl(i)
Xl(i) = a0 + a1 * tempX + a2 * tempY
Yl(i) = b0 + b1 * tempX + b2 * tempY
'txtShow.Text = txtShow.Text & vbCrLf & x1(i) & " " & y1(i) & " " & "x=" & Str(Format(x(i), "0.000000")) & " , y=" & Str(Format(y(i), "0.000000"))
Next i
'輸入第二張像片的定向參數數據++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CDg1.DialogTitle = "讀取第二張像片的定向參數"
CDg1.FileName = "": CDg1.Action = 1
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -