📄 前后方交会三维坐标计算运行主窗口.frm
字号:
VERSION 5.00
Begin VB.Form Form7
BackColor = &H80000002&
Caption = "摄影测量前后方交会处理窗体"
ClientHeight = 6735
ClientLeft = 165
ClientTop = 870
ClientWidth = 8895
LinkTopic = "Form7"
ScaleHeight = 6735
ScaleWidth = 8895
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame3
Caption = "处理程序信息控制面板"
Height = 5655
Left = 0
TabIndex = 0
Top = 1080
Width = 8895
Begin VB.Frame frame6
Caption = "内定向"
Height = 2055
Left = 4320
TabIndex = 31
Top = 240
Width = 4335
Begin VB.Frame Frame4
Caption = "选择处理相片"
Height = 1695
Left = 360
TabIndex = 33
Top = 240
Width = 1335
Begin VB.OptionButton Option1
Caption = "左相片"
Height = 255
Left = 240
TabIndex = 35
Top = 480
Width = 975
End
Begin VB.OptionButton Option2
Caption = "右相片"
Height = 255
Left = 240
TabIndex = 34
Top = 1080
Width = 855
End
End
Begin VB.CommandButton Command1
Caption = "影象坐标已经全部转换完毕"
Height = 735
Left = 2040
TabIndex = 32
Top = 720
Width = 2055
End
Begin VB.Timer Timer1
Interval = 50
Left = 2760
Top = 840
End
End
Begin VB.Frame Frame5
Caption = "后方交会三个角度的改正量的数值"
Height = 3015
Left = 360
TabIndex = 20
Top = 2400
Width = 3615
Begin VB.CommandButton Command2
Caption = "左右相片均已经通过了后方交会计算"
Height = 2415
Left = 2640
TabIndex = 21
Top = 360
Width = 615
End
Begin VB.Label Label7
Caption = "迭代的次数"
Height = 375
Left = 240
TabIndex = 30
Top = 2520
Width = 1095
End
Begin VB.Label Label8
Height = 375
Left = 1680
TabIndex = 29
Top = 2520
Width = 615
End
Begin VB.Label Label14
Height = 375
Left = 1680
TabIndex = 28
Top = 2040
Width = 495
End
Begin VB.Label Label13
Height = 495
Left = 1680
TabIndex = 27
Top = 1440
Width = 495
End
Begin VB.Label Label12
Height = 495
Left = 1680
TabIndex = 26
Top = 960
Width = 615
End
Begin VB.Label Label11
Caption = "$K"
Height = 375
Left = 360
TabIndex = 25
Top = 2040
Width = 855
End
Begin VB.Label Label10
Caption = "$W"
Height = 375
Left = 360
TabIndex = 24
Top = 1440
Width = 735
End
Begin VB.Label Label9
Caption = "$Q"
Height = 375
Left = 360
TabIndex = 23
Top = 960
Width = 615
End
Begin VB.Label Label6
Caption = "迭代计算中最后的三个角元素的改正数"
Height = 615
Left = 360
TabIndex = 22
Top = 240
Width = 1575
End
End
Begin VB.Frame Frame2
Caption = "关于精度估算的最后结果"
Height = 3015
Left = 4320
TabIndex = 7
Top = 2400
Width = 4335
Begin VB.TextBox Text6
Height = 495
Left = 2040
TabIndex = 11
Top = 2160
Width = 1815
End
Begin VB.TextBox Text5
Height = 495
Left = 2040
TabIndex = 10
Top = 1680
Width = 1815
End
Begin VB.TextBox Text4
Height = 495
Left = 2040
TabIndex = 9
Top = 960
Width = 1815
End
Begin VB.TextBox Text3
Height = 495
Left = 2040
TabIndex = 8
Top = 480
Width = 1815
End
Begin VB.Label Label17
Caption = "总的平面精度"
Height = 375
Left = 720
TabIndex = 19
Top = 2280
Width = 1215
End
Begin VB.Label Label5
Caption = " Ｚ的精度"
Height = 375
Left = 240
TabIndex = 18
Top = 1800
Width = 1455
End
Begin VB.Label Label4
Caption = " Ｙ的精度"
Height = 375
Left = 240
TabIndex = 17
Top = 1080
Width = 1455
End
Begin VB.Label Label3
Caption = " Ｘ的精度"
Height = 375
Left = 240
TabIndex = 16
Top = 600
Width = 1335
End
Begin VB.Label Label18
Caption = "m"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3960
TabIndex = 15
Top = 480
Width = 255
End
Begin VB.Label Label19
Caption = "m"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 14
Top = 1080
Width = 255
End
Begin VB.Label Label20
Caption = "m"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3960
TabIndex = 13
Top = 1680
Width = 255
End
Begin VB.Label Label21
Caption = "m"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 12
Top = 2280
Width = 255
End
End
Begin VB.Frame Frame1
Caption = "关于控制点的信息"
Height = 2055
Left = 360
TabIndex = 1
Top = 240
Width = 3615
Begin VB.TextBox Text2
Height = 495
Left = 1920
TabIndex = 3
Text = "0.15324"
Top = 1320
Width = 1095
End
Begin VB.TextBox Text1
Height = 495
Left = 1920
TabIndex = 2
Text = "4"
Top = 600
Width = 1335
End
Begin VB.Label Label2
Caption = "相片的焦距"
Height = 375
Left = 240
TabIndex = 6
Top = 1440
Width = 1215
End
Begin VB.Label Label1
Caption = "求算外方位元素的地面控制点的个数"
Height = 615
Left = 120
TabIndex = 5
Top = 600
Width = 1575
End
Begin VB.Label Label15
Caption = "m"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3120
TabIndex = 4
Top = 1440
Width = 255
End
End
End
Begin VB.Label Label16
Caption = "摄影测量内定向、前后方交会、精度估算应用程序窗体"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 36
Top = 240
Width = 10935
End
Begin VB.Label Label22
Height = 735
Left = 0
TabIndex = 37
Top = 120
Width = 8895
End
Begin VB.Menu interdir
Caption = "内定向"
Begin VB.Menu caculate6
Caption = "求解定向六个元素"
End
Begin VB.Menu convert
Caption = "转化影象坐标为框标"
End
End
Begin VB.Menu caculate
Caption = "运算"
Begin VB.Menu outfactor
Caption = "求解外方位元素"
End
Begin VB.Menu forwardintersect
Caption = "前方交会"
End
Begin VB.Menu acurracy
Caption = "结算精度"
End
End
Begin VB.Menu clearend
Caption = "清除和结束"
Begin VB.Menu clear
Caption = "清除文本框"
End
Begin VB.Menu end
Caption = "结束"
End
End
Begin VB.Menu return
Caption = "切换到主界面"
Begin VB.Menu returnmain
Caption = "切换到应用程序主界面"
End
End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Private Sub acurracy_Click()
Dim i As Integer
Dim n As Integer
Dim X As Double, Y As Double, z As Double
Dim x1() As Double, y1() As Double, z1() As Double
Dim x2() As Double, y2() As Double, z2() As Double
Dim ch As String
Dim id As Integer
n = InputBox("输入求解精度的控制点的个数")
ReDim x1(n)
ReDim y1(n)
ReDim z1(n)
ReDim x2(n)
ReDim y2(n)
ReDim z2(n)
Open "已知的控制点的坐标.txt" For Input As #1
Line Input #1, ch
For i = 1 To n
Input #1, x1(i)
Input #1, y1(i)
Input #1, z1(i)
Next i
Close #1
Open "结算的点的控制坐标.txt" For Input As #1
Line Input #1, ch
For i = 1 To n
Input #1, id
Input #1, x2(i)
Input #1, y2(i)
Input #1, z2(i)
Next i
Close #1
For i = 1 To n
X = X + (x1(i) - x2(i)) ^ 2
Y = Y + (y1(i) - y2(i)) ^ 2
z = z + (z1(i) - z2(i)) ^ 2
Next i
Text3.Text = (X / n) ^ (1 / 2)
Text4.Text = (Y / n) ^ (1 / 2)
Text5.Text = (z / n) ^ (1 / 2)
Text6.Text = ((X / n) + (Y / n)) ^ (1 / 2)
End Sub
Private Sub caculate6_Click()
Dim n As Integer, sc(6, 1) As Double
Dim X() As Double, Y() As Double, x1() As Double, y1() As Double
Dim a0 As Double, a1 As Double, a2 As Double
Dim b0 As Double, b1 As Double, b2 As Double
Dim a() As Double, l() As Double, i As Integer, d As Integer
Dim mtxAt() As Double, mtxC1(6, 6) As Double, chx() As Double
Dim gz() As Double, j As Integer
d = 1
n = InputBox("输入进行仿射变换参数求解的点的个数")
ReDim a(2 * n, 6)
ReDim l(2 * n, 1)
ReDim x1(n)
ReDim y1(n)
ReDim X(n)
ReDim Y(n)
Open "仿射.txt" For Input As #1
For i = 1 To n
Input #1, X(i)
Input #1, Y(i)
Input #1, x1(i)
Input #1, y1(i)
Next i
Close #1
For i = 1 To n
a(d, 1) = 1
a(d, 2) = x1(i)
a(d, 3) = y1(i)
a(d, 4) = 0
a(d, 5) = 0
a(d, 6) = 0
a(d + 1, 1) = 0
a(d + 1, 2) = 0
a(d + 1, 3) = 0
a(d + 1, 4) = 1
a(d + 1, 5) = x1(i)
a(d + 1, 6) = y1(i)
d = d + 2
Next i
d = 1
For i = 1 To n
l(d, 1) = X(i)
d = d + 1
l(d, 1) = Y(i)
d = d + 1
Next i
ReDim mtxAt(6, 2 * n)
Call MTrans(2 * n, 6, a(), mtxAt()) '求转置距阵
Call MMul(6, 2 * n, 6, mtxAt(), a(), mtxC1())
Call MRinv(6, mtxC1())
ReDim chx(6, 2 * n)
Call MMul(6, 6, 2 * n, mtxC1(), mtxAt(), chx())
ReDim gz(6, 1)
Call MMul(6, 2 * n, 1, chx(), l(), gz())
Open "变换参数.txt" For Output As #1
Print #1, gz(1, 1)
Print #1, gz(2, 1)
Print #1, gz(3, 1)
Print #1, gz(4, 1)
Print #1, gz(5, 1)
Print #1, gz(6, 1)
Close #1
MsgBox ("已经转换完毕")
Frame3.Enabled = True
Frame1.Enabled = False
Frame2.Enabled = False
Frame5.Enabled = False
End Sub
Private Sub clear_Click()
Text1.Text = ""
Text2.Text = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -