后方交会.frm

来自「摄影测量中后方交会算法的实现」· FRM 代码 · 共 1,220 行 · 第 1/3 页

FRM
1,220
字号
   n = n + 1
   If n Mod 5 = 1 Then
      Set Item = ListView1.ListItems.Add(ptNo, "N" & ptNo, "")
      Item.Checked = True
      Item.SubItems(1) = ptNo
      Item.SubItems(2) = Val(Data) / 1000
   ElseIf n Mod 5 = 2 Then
      Item.SubItems(3) = Val(Data) / 1000
   ElseIf n Mod 5 = 3 Then
      Item.SubItems(4) = Val(Data)
   ElseIf n Mod 5 = 4 Then
      Item.SubItems(5) = Val(Data)
   ElseIf n Mod 5 = 0 Then
      Item.SubItems(6) = Val(Data)
      ptNo = ptNo + 1
   End If
   
Loop
Close #1

ReDim X1(1 To ptNo - 1) As Single
ReDim Y1(1 To ptNo - 1) As Single
'ReDim Ax2(1 To ptNo) As single
'ReDim Ay2(1 To ptNo) As single
ReDim Xtp1(1 To ptNo - 1) As Single
ReDim Ytp1(1 To ptNo - 1) As Single
ReDim Ztp1(1 To ptNo - 1) As Single
'ReDim X2(1 To ptNo) As single
'ReDim Y2(1 To ptNo) As single
'ReDim Z2(1 To ptNo) As single
'ReDim N1(1 To ptNo) As single
'ReDim N2(1 To ptNo) As single
With ListView4.ColumnHeaders
     .Clear
     .Add 1, "Check", "", 300
     .Add 2, "No", "点", 350
     For i = 1 To 6
        .Add i + 2, "ATA(" & i & ")", "ATA(" & i & ")", 1600
     Next i
     .Add 9, "LL", "LL", 1600
End With

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

Private Sub Command2_Click()
Xs0 = 0
Ys0 = 0
Zs0 = 0

For i = 1 To ptNo - 1
    X1(i) = ListView1.ListItems(i).SubItems(2)
    Y1(i) = ListView1.ListItems(i).SubItems(3)
    Xtp1(i) = ListView1.ListItems(i).SubItems(4)
    Ytp1(i) = ListView1.ListItems(i).SubItems(5)
    Ztp1(i) = ListView1.ListItems(i).SubItems(6)
Next i

For i = 1 To ptNo - 1
    Xs0 = Xtp1(i) + Xs0
    Ys0 = Ytp1(i) + Ys0
Next i

Xs0 = Xs0 / (ptNo - 1)
Ys0 = Ys0 / (ptNo - 1)
Text3.Text = Val(Text1.Text) * Val(Text2.Text)
Text4.Text = Xs0
Text5.Text = Ys0

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

Private Sub Command3_Click()
m = Val(Text1.Text)
f = Val(Text2.Text)
Xs0 = Val(Text4.Text)
Ys0 = Val(Text5.Text)
Zs0 = Val(Text3.Text)
Alf2 = Val(Text6.Text)
Omg2 = Val(Text7.Text)
Kp2 = Val(Text8.Text)

For i = 1 To ptNo - 1
    XX = R1(1) * (Xtp1(i) - Xs0) + R1(4) * (Ytp1(i) - Ys0) + R1(7) * (Ztp1(i) - Zs0)
    YY = R1(2) * (Xtp1(i) - Xs0) + R1(5) * (Ytp1(i) - Ys0) + R1(8) * (Ztp1(i) - Zs0)
    ZZ = R1(3) * (Xtp1(i) - Xs0) + R1(6) * (Ytp1(i) - Ys0) + R1(9) * (Ztp1(i) - Zs0)

    A(1, 1) = (R1(1) * f + R1(3) * X1(i)) / ZZ
    A(1, 2) = (R1(4) * f + R1(6) * X1(i)) / ZZ
    A(1, 3) = (R1(7) * f + R1(9) * X1(i)) / ZZ
    A(2, 1) = (R1(2) * f + R1(3) * Y1(i)) / ZZ
    A(2, 2) = (R1(5) * f + R1(6) * Y1(i)) / ZZ
    A(2, 3) = (R1(8) * f + R1(9) * Y1(i)) / ZZ
    
    A(1, 4) = Y1(i) * Sin(Omg2) - ((X1(i) / f) * (X1(i) * Cos(Kp2) - Y1(i) * Sin(Kp2)) + f * Cos(Kp2)) * Cos(Omg2)
    A(1, 5) = -f * Sin(Kp2) - (X1(i) / f) * (X1(i) * Sin(Kp2) + Y1(i) * Cos(Kp2))
    A(1, 6) = Y1(i)
    A(2, 4) = -X1(i) * Sin(Omg2) - ((X1(i) / f) * (X1(i) * Cos(Kp2) - Y1(i) * Sin(Kp2)) - f * Sin(Kp2)) * Cos(Omg2)
    A(2, 5) = -f * Cos(Kp2) - (Y1(i) / f) * (X1(i) * Sin(Kp2) + Y1(i) * Cos(Kp2))
    A(2, 6) = -X1(i)
    
    Set Item = ListView2.ListItems.Add(i, "N" & i, "")
    Item.Checked = True
    Item.SubItems(1) = i
    Item.SubItems(2) = A(1, 1)
    Item.SubItems(3) = A(1, 2)
    Item.SubItems(4) = A(1, 3)
    Item.SubItems(5) = A(1, 4)
    Item.SubItems(6) = A(1, 5)
    Item.SubItems(7) = A(1, 6)
    Item.SubItems(8) = A(2, 1)
    Item.SubItems(9) = A(2, 2)
    Item.SubItems(10) = A(2, 3)
    Item.SubItems(11) = A(2, 4)
    Item.SubItems(12) = A(2, 5)
    Item.SubItems(13) = A(2, 6)
    
    Set Item = ListView3.ListItems.Add(i, "N" & i, "")
    Item.Checked = True
    Item.SubItems(1) = i
    Item.SubItems(2) = (XX / ZZ) * (-f)
    Item.SubItems(3) = (YY / ZZ) * (-f)
    Item.SubItems(4) = X1(i) - (XX / ZZ) * (-f)
    Item.SubItems(5) = Y1(i) - (YY / ZZ) * (-f)
Next i

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

Private Sub Command4_Click()
ReDim VV(1 To 6) As Single
ReDim AA(1 To 2 * (ptNo - 1), 1 To 6) As Single
ReDim LL(1 To 2 * (ptNo - 1)) As Single
ReDim ATA(1 To 6, 1 To 6) As Single
ReDim ATL(1 To 6) As Single

For i = 1 To 2 * (ptNo - 1)
    If i Mod 2 = 1 Then
        AA(i, 1) = ListView2.ListItems((i + 1) \ 2).SubItems(2)
        AA(i, 2) = ListView2.ListItems((i + 1) \ 2).SubItems(3)
        AA(i, 3) = ListView2.ListItems((i + 1) \ 2).SubItems(4)
        AA(i, 4) = ListView2.ListItems((i + 1) \ 2).SubItems(5)
        AA(i, 5) = ListView2.ListItems((i + 1) \ 2).SubItems(6)
        AA(i, 6) = ListView2.ListItems((i + 1) \ 2).SubItems(7)
        LL(i) = ListView3.ListItems((i + 1) \ 2).SubItems(4)
    Else
        AA(i, 1) = ListView2.ListItems((i + 1) \ 2).SubItems(8)
        AA(i, 2) = ListView2.ListItems((i + 1) \ 2).SubItems(9)
        AA(i, 3) = ListView2.ListItems((i + 1) \ 2).SubItems(10)
        AA(i, 4) = ListView2.ListItems((i + 1) \ 2).SubItems(11)
        AA(i, 5) = ListView2.ListItems((i + 1) \ 2).SubItems(12)
        AA(i, 6) = ListView2.ListItems((i + 1) \ 2).SubItems(13)
        LL(i) = ListView3.ListItems((i + 1) \ 2).SubItems(5)
    End If
Next i

For i = 1 To 6
    For j = 1 To 6
        ATA(i, j) = 0
        For k = 1 To 2 * (ptNo - 1)
            ATA(i, j) = AA(k, i) * AA(k, j) + ATA(i, j)
        Next k
    Next j
Next i

For i = 1 To 6
    ATL(i) = 0
    For j = 1 To 2 * (ptNo - 1)
        ATL(i) = AA(j, i) * LL(j) + ATL(i)
    Next j
Next i

For i = 1 To 6
    Set Item = ListView4.ListItems.Add(i, "N" & i, "")
    Item.Checked = True
    Item.SubItems(1) = i
    Item.SubItems(2) = ATA(i, 1)
    Item.SubItems(3) = ATA(i, 2)
    Item.SubItems(4) = ATA(i, 3)
    Item.SubItems(5) = ATA(i, 4)
    Item.SubItems(6) = ATA(i, 5)
    Item.SubItems(7) = ATA(i, 6)
    Item.SubItems(8) = ATL(i)
Next i

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

Private Sub Command5_Click()
Dim ATA2(5, 5) As Double
For i = 0 To 5
    For j = 0 To 5
        ATA2(i, j) = ATA(i + 1, j + 1)
    Next j
Next i

Dinvert ATA2(), 5

For i = 1 To 6
    For j = 1 To 6
        ATA(i, j) = ATA2(i - 1, j - 1)
    Next j
Next i

For i = 1 To 6
    VV(i) = ATA(i, 1) * ATL(1) + ATA(i, 2) * ATL(2) + ATA(i, 3) * ATL(3) + ATA(i, 4) * ATL(4) + ATA(i, 5) * ATL(5) + ATA(i, 6) * ATL(6)
    Set Item = ListView5.ListItems.Add(i, "N" & i, "")
    Item.Checked = True
    Item.SubItems(1) = i
    Item.SubItems(2) = VV(i)
Next i

For i = 1 To 6
    If Abs(VV(i)) > Val(Text9(i - 1).Text) Then
        Check1(i - 1).Value = 1
        Command6.Enabled = True
    Else
        Check1(i - 1).Value = 0
    End If
Next i

Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False

End Sub

Private Sub Command6_Click()
Text4.Text = Val(Text4.Text) + VV(1)
Text5.Text = Val(Text5.Text) + VV(2)
Text3.Text = Val(Text3.Text) + VV(3)
Text6.Text = Val(Text6.Text) + VV(4)
Text7.Text = Val(Text7.Text) + VV(5)
Text8.Text = Val(Text8.Text) + VV(6)
ListView2.ListItems.Clear
ListView3.ListItems.Clear
ListView4.ListItems.Clear
ListView5.ListItems.Clear

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

Private Sub Form_Load()
With ListView1.ColumnHeaders
     .Clear
     .Add 1, "Check", "", 300
     .Add 2, "No", "点", 350
     .Add 3, "x", "像点x", 900
     .Add 4, "y", "像点y", 900
     .Add 5, "Xtp", "摄影X", 1200
     .Add 6, "Ytp", "摄影Y", 1200
     .Add 7, "Ztp", "摄影Z", 900
End With

With ListView2.ColumnHeaders
     .Clear
     .Add 1, "Check", "", 300
     .Add 2, "No", "点", 350
     .Add 3, "a11", "a11", 1500
     .Add 4, "a12", "a12", 1500
     .Add 5, "a13", "a13", 1500
     .Add 6, "a14", "a14", 1500
     .Add 7, "a15", "a15", 1500
     .Add 8, "a16", "a16", 1500
     .Add 9, "a21", "a21", 1500
     .Add 10, "a22", "a22", 1500
     .Add 11, "a23", "a23", 1500
     .Add 12, "a24", "a24", 1500
     .Add 13, "a25", "a25", 1500
     .Add 14, "a26", "a26", 1500
End With

With ListView3.ColumnHeaders
     .Clear
     .Add 1, "Check", "", 300
     .Add 2, "No", "点", 350
     .Add 3, "x", "x", 2000
     .Add 4, "y", "y", 2000
     .Add 5, "lx", "lx", 2000
     .Add 6, "ly", "ly", 2000
End With

With ListView5.ColumnHeaders
     .Clear
     .Add 1, "Check", "", 300
     .Add 2, "No", "点", 350
     .Add 3, "VV", "VV", 2500
End With

Text1.Text = 4000 '4286.14126581772
Text2.Text = 0.210681 '210.681 '
Text6.Text = 0
Text7.Text = 0
Text8.Text = 0

For i = 0 To 2
    Text9(i).Text = 1
Next i

For i = 3 To 5
    Text9(i).Text = 0.00001
Next i

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

Private Sub Text1_Change()
Text3.Text = Val(Text1.Text) * Val(Text2.Text)
End Sub

Private Sub Text2_Change()
Text3.Text = Val(Text1.Text) * Val(Text2.Text)
End Sub

Private Sub Text6_Change()
Alf2 = Val(Text6.Text)
Omg2 = Val(Text7.Text)
Kp2 = Val(Text8.Text)

R1(1) = Cos(Alf2) * Cos(Kp2) - Sin(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(2) = -Cos(Alf2) * Sin(Kp2) - Sin(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(3) = -Sin(Alf2) * Cos(Omg2)
R1(4) = Cos(Omg2) * Sin(Kp2)
R1(5) = Cos(Omg2) * Cos(Kp2)
R1(6) = -Sin(Omg2)
R1(7) = Sin(Alf2) * Cos(Kp2) + Cos(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(8) = -Sin(Alf2) * Sin(Kp2) + Cos(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(9) = Cos(Alf2) * Cos(Omg2)

For i = 0 To 8
    Text10(i).Text = R1(i + 1)
Next i
End Sub

Private Sub Text7_Change()
Alf2 = Val(Text6.Text)
Omg2 = Val(Text7.Text)
Kp2 = Val(Text8.Text)

R1(1) = Cos(Alf2) * Cos(Kp2) - Sin(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(2) = -Cos(Alf2) * Sin(Kp2) - Sin(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(3) = -Sin(Alf2) * Cos(Omg2)
R1(4) = Cos(Omg2) * Sin(Kp2)
R1(5) = Cos(Omg2) * Cos(Kp2)
R1(6) = -Sin(Omg2)
R1(7) = Sin(Alf2) * Cos(Kp2) + Cos(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(8) = -Sin(Alf2) * Sin(Kp2) + Cos(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(9) = Cos(Alf2) * Cos(Omg2)

For i = 0 To 8
    Text10(i).Text = R1(i + 1)
Next i
End Sub

Private Sub Text8_Change()
Alf2 = Val(Text6.Text)
Omg2 = Val(Text7.Text)
Kp2 = Val(Text8.Text)

R1(1) = Cos(Alf2) * Cos(Kp2) - Sin(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(2) = -Cos(Alf2) * Sin(Kp2) - Sin(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(3) = -Sin(Alf2) * Cos(Omg2)
R1(4) = Cos(Omg2) * Sin(Kp2)
R1(5) = Cos(Omg2) * Cos(Kp2)
R1(6) = -Sin(Omg2)
R1(7) = Sin(Alf2) * Cos(Kp2) + Cos(Alf2) * Sin(Omg2) * Sin(Kp2)
R1(8) = -Sin(Alf2) * Sin(Kp2) + Cos(Alf2) * Sin(Omg2) * Cos(Kp2)
R1(9) = Cos(Alf2) * Cos(Omg2)

For i = 0 To 8
    Text10(i).Text = R1(i + 1)
Next i
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?