form1.frm

摄影测量中将数据读入

Erase YYr
ListView1.ListItems.Clear
ListView2.ListItems.Clear

Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
   Line Input #1, InputData
   n = n + 1
   If n Mod 4 = 1 Then
      Set objItem = ListView1.ListItems.Add(ptNo + 1, "N" & ptNo, "")
      objItem.Checked = True
      objItem.SubItems(1) = ptNo + 1
      objItem.SubItems(2) = Val(InputData)
   ElseIf n Mod 4 = 2 Then
      objItem.SubItems(3) = Val(InputData)
   ElseIf n Mod 4 = 3 Then
      objItem.SubItems(4) = Val(InputData)
   ElseIf n Mod 4 = 0 Then
      objItem.SubItems(5) = Val(InputData)
      ptNo = ptNo + 1
   End If
Loop

Close #1

Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = False
Command4.Enabled = True
End Sub

Private Sub Command2_Click()
Form1.Height = 9165
Command2.Enabled = False
Command3.Enabled = True

'求取9036及赋予9037内定向参数
'*********************
AA(0, 0) = 1
AA(0, 1) = 583#
AA(0, 2) = 584.75
AA(1, 0) = 1
AA(1, 1) = 10677.25
AA(1, 2) = 587.75
AA(2, 0) = 1
AA(2, 1) = 10674.25
AA(2, 2) = 10681.75
AA(3, 0) = 1
AA(3, 1) = 580#
AA(3, 2) = 10679#

LLx(0) = -106#
LLx(1) = 106#
LLx(2) = 106#
LLx(3) = -106#
LLy(0) = 106#
LLy(1) = 106#
LLy(2) = -106#
LLy(3) = -106#

For i = 0 To 3
   For j = 0 To 2
      AAt(j, i) = AA(i, j)
   Next j
Next i

For i = 0 To 2
   For j = 0 To 2
      AAtAA(i, j) = AA(0, j) * AAt(i, 0) + AA(1, j) * AAt(i, 1) + AA(2, j) * AAt(i, 2) + AA(3, j) * AAt(i, 3)
      QQ(i, j) = AAtAA(i, j)
   Next j
Next i

For i = 0 To 2
   AAtLLx(i) = AAt(i, 0) * LLx(0) + AAt(i, 1) * LLx(1) + AAt(i, 2) * LLx(2)
   AAtLLy(i) = AAt(i, 0) * LLy(0) + AAt(i, 1) * LLy(1) + AAt(i, 2) * LLy(2)
Next i

Call Dinvert(QQ(), 3)

For i = 0 To 2
   HHl(i) = QQ(i, 0) * AAtLLx(0) + QQ(i, 1) * AAtLLx(1) + QQ(i, 2) * AAtLLx(2)
   KKl(i) = QQ(i, 0) * AAtLLy(0) + QQ(i, 1) * AAtLLy(1) + QQ(i, 2) * AAtLLy(2)
Next i

HHr(0) = -117.139404645129
HHr(1) = 2.10015882716702E-02
HHr(2) = 7.88415216188798E-06
KKr(0) = 118.12876758509
KKr(1) = 7.58096126016391E-06
KKr(2) = -2.10022467794216E-02
'*********************

'获取Xs1,Xs2,Ys1,Ys2,Zs1,Zs2
'****************
Xs1 = -0.0082
Xs2 = Xs1 + Val(Text7.Text)
Ys1 = 0.0251
Ys2 = Ys1 + Val(Text8.Text)
Zs1 = 23
Zs2 = Zs1 + Val(Text9.Text)
'****************

'摄影基线B的三个坐标分量
'*********************
Bx = Val(Text7.Text)
By = Val(Text8.Text)
Bz = Val(Text9.Text)
'*********************

'求出旋转矩阵
'*************************************************
Fai1 = Val(Text1.Text)
Fai2 = Val(Text4.Text)
Omiga1 = Val(Text2.Text)
Omiga2 = Val(Text5.Text)
Kapa1 = Val(Text3.Text)
Kapa2 = Val(Text6.Text)

CangF1 = Cos(Fai1)
SangF1 = Sin(Fai1)
CangO1 = Cos(Omiga1)
SangO1 = Sin(Omiga1)
CangK1 = Cos(Kapa1)
SangK1 = Sin(Kapa1)

CangF2 = Cos(Fai2)
SangF2 = Sin(Fai2)
CangO2 = Cos(Omiga2)
SangO2 = Sin(Omiga2)
CangK2 = Cos(Kapa2)
SangK2 = Sin(Kapa2)

La1 = CangF1 * CangK1 - SangF1 * SangO1 * SangK1
La2 = -CangF1 * SangK1 - SangF1 * SangO1 * CangK1
La3 = -SangF1 * CangO1
Lb1 = CangO1 * SangK1
Lb2 = CangO1 * CangK1
Lb3 = -SangO1
Lc1 = SangF1 * CangK1 + CangF1 * SangO1 * SangK1
Lc2 = -SangF1 * SangK1 + CangF1 * SangO1 * CangK1
Lc3 = CangF1 * CangO1

Ra1 = CangF2 * CangK2 - SangF2 * SangO2 * SangK2
Ra2 = -CangF2 * SangK2 - SangF2 * SangO2 * CangK2
Ra3 = -SangF2 * CangO2
Rb1 = CangO2 * SangK2
Rb2 = CangO2 * CangK2
Rb3 = -SangO2
Rc1 = SangF2 * CangK2 + CangF2 * SangO2 * SangK2
Rc2 = -SangF2 * SangK2 + CangF2 * SangO2 * CangK2
Rc3 = CangF2 * CangO2
'**********************************************

'XXl(0) = 5748: YYl(0) = 2357
'XXr(0) = 1883: YYr(0) = 2256
'XXl(1) = 5729: YYl(1) = 3224
'XXr(1) = 1881: YYr(1) = 3124
'XXl(2) = 5433: YYl(2) = 7231
'XXr(2) = 1566: YYr(2) = 7131
'XXl(3) = 5134: YYl(3) = 10726
'XXr(3) = 1297: YYr(3) = 10620
'XXl(4) = 9172: YYl(4) = 6471
'XXr(4) = 5326: YYr(4) = 6369
'XXl(5) = 9150: YYl(5) = 1065
'XXr(5) = 5248: YYr(5) = 958
'XXl(6) = 5191: YYl(6) = 1162
'XXr(6) = 1349: YYr(6) = 1058
'XXl(7) = 4858: YYl(7) = 4495
'XXr(7) = 1017: YYr(7) = 4395
'XXl(8) = 5102: YYl(8) = 6693
'XXr(8) = 1222: YYr(8) = 6593
'XXl(9) = 8322: YYl(9) = 6560
'XXr(9) = 4433: YYr(9) = 6459
ReDim XXl(1 To ptNo) As Single
ReDim YYl(1 To ptNo) As Single
ReDim XXr(1 To ptNo) As Single
ReDim YYr(1 To ptNo) As Single

For i = 1 To ptNo
   If ListView1.ListItems(i).Checked = True Then
    XXl(i) = Val(ListView1.ListItems(i).SubItems(2))
    XXr(i) = Val(ListView1.ListItems(i).SubItems(3))
    YYl(i) = Val(ListView1.ListItems(i).SubItems(4))
    YYr(i) = Val(ListView1.ListItems(i).SubItems(5))
    
    HHl(0) = -118.25225846869
    HHl(1) = 2.10026596666528E-02
    HHl(2) = 6.35240590130698E-06
    KKl(0) = 118.281828724578
    KKl(1) = 6.05107526811254E-06
    KKl(2) = -2.10027401742566E-02
    
    '地面点的相应像点a1,a2的像空间坐标
    '************
    F = -303.883
    X1 = HHl(0) + HHl(1) * XXl(i) + HHl(2) * YYl(i)
    Y1 = KKl(0) + KKl(1) * XXl(i) + KKl(2) * YYl(i)
    X2 = HHr(0) + HHr(1) * XXr(i) + HHr(2) * YYr(i)
    Y2 = KKr(0) + KKr(1) * XXr(i) + KKr(2) * YYr(i)
    '************
    
    '求取像空间辅助坐标
    '***********************************
    Fx1 = La1 * X1 + La2 * Y1 + La3 * F
    Fy1 = Lb1 * X1 + Lb2 * Y1 + Lb3 * F
    Fz1 = Lc1 * X1 + Lc2 * Y1 + Lc3 * F
    
    Fx2 = La1 * X2 + La2 * Y2 + La3 * F
    Fy2 = Lb1 * X2 + Lb2 * Y2 + Lb3 * F
    Fz2 = Lc1 * X2 + Lc2 * Y2 + Lc3 * F
    '***********************************
    
    '求取投影系数N1,N2
    '*****************************************************
    N1 = (Bx * Fz2 - Bz * Fx2) / (Fx1 * Fz2 - Fx2 * Fz1)
    N2 = (Bx * Fz1 - Bz * Fx1) / (Fx1 * Fz2 - Fx2 * Fz1)
    '*****************************************************
    
    '求出地面点的坐标
    '******************************************
    Xa = Xs1 + N1 * Fx1
    Ya = 0.5 * (Ys1 + N1 * Fy1 + Ys2 + N2 * Fy2)
    Qa = (Ys1 + N1 * Fy1) - (Ys2 + N2 * Fy2)
    Za = Zs1 + N1 * Fz1
    '******************************************
    
    '投影系数、地面点及Q输出
    '*******************************
      Set objItem = ListView2.ListItems.Add(i, "N" & i, "")
      objItem.Checked = True
      objItem.SubItems(1) = i
      objItem.SubItems(2) = Format(Val(N1), "###.####")
      objItem.SubItems(3) = Format(Val(N2), "###.####")
      objItem.SubItems(4) = Format(Val(Xa), "###.####")
      objItem.SubItems(5) = Format(Val(Ya), "###.####")
      objItem.SubItems(6) = Format(Val(Za), "###.####")
      objItem.SubItems(7) = Format(Val(Qa), "###.####")
    '*******************************
    
   End If
Next i
t = 1
End Sub

Private Sub Command3_Click()
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
    Print #1, "No"; Tab(5); "N1"; Tab(35); "N2"; Tab(65); "Xa"; Tab(95); "Ya"; Tab(125); "Za"
    For i = 1 To ptNo
      If ListView2.ListItems(i).Checked = True Then
        N1 = Val(ListView2.ListItems(i).SubItems(2))
        N2 = Val(ListView2.ListItems(i).SubItems(3))
        Xa = Val(ListView2.ListItems(i).SubItems(4))
        Ya = Val(ListView2.ListItems(i).SubItems(5))
        Za = Val(ListView2.ListItems(i).SubItems(6))
        Print #1, i; Tab(5); N1; Tab(35); N2; Tab(65); Xa; Tab(95); Ya; Tab(125); Za
      End If
    Next i
Close #1
End Sub

Private Sub Command4_Click()
ptNo = 0
Erase XXl
Erase XXr
Erase YYl
Erase YYr

ListView1.ListItems.Clear
ListView2.ListItems.Clear
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Form1.Height = 6360
End Sub

Private Sub Form_Load()
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Form1.Height = 6360

With ListView1.ColumnHeaders
    .Clear
    .Add 1, "check", "", 300
    .Add 2, "No", "点号", 500
    .Add 3, "Lx", "左片X", 1300
    .Add 4, "Ly", "左片Y", 1300
    .Add 5, "Rx", "右片X", 1300
    .Add 6, "Ry", "右片Y", 1300
End With
ListView1.HideColumnHeaders = False

With ListView2.ColumnHeaders
    .Clear
    .Add 1, "check", "", 300
    .Add 2, "No", "点号", 500
    .Add 3, "N1", "N1", 1100
    .Add 4, "N2", "N2", 1100
    .Add 5, "Xa", "Xa", 1000
    .Add 6, "Ya", "Ya", 1000
    .Add 7, "Za", "Za", 1000
    .Add 8, "Q", "Q", 1000
End With
ListView2.HideColumnHeaders = False
End Sub