空间后交.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