📄
字号:
Left = 120
TabIndex = 13
Top = 960
Width = 375
End
Begin VB.Label Label6
Caption = "Ys="
Height = 255
Left = 120
TabIndex = 11
Top = 600
Width = 375
End
Begin VB.Label Label5
Caption = "Xs="
Height = 255
Left = 120
TabIndex = 9
Top = 240
Width = 495
End
End
Begin VB.Frame Frame1
Caption = "内方位元素"
Height = 1335
Left = 360
TabIndex = 1
Top = 840
Width = 1455
Begin VB.TextBox Text3
Height = 270
Left = 480
TabIndex = 7
Top = 960
Width = 735
End
Begin VB.TextBox Text2
Height = 270
Left = 480
TabIndex = 5
Top = 600
Width = 735
End
Begin VB.TextBox Text1
Height = 270
Left = 480
TabIndex = 3
Top = 240
Width = 735
End
Begin VB.Label Label4
Caption = "f="
Height = 255
Left = 120
TabIndex = 6
Top = 960
Width = 375
End
Begin VB.Label Label3
Caption = "y0="
Height = 255
Left = 120
TabIndex = 4
Top = 600
Width = 615
End
Begin VB.Label Label2
Caption = "x0="
Height = 255
Left = 120
TabIndex = 2
Top = 240
Width = 615
End
End
Begin VB.Line Line1
X1 = 360
X2 = 8880
Y1 = 2880
Y2 = 2880
End
Begin VB.Label Label21
Caption = "1:"
Height = 255
Left = 7800
TabIndex = 59
Top = 2400
Width = 495
End
Begin VB.Label Label31
Caption = "比例尺"
Height = 255
Left = 7800
TabIndex = 56
Top = 2160
Width = 735
End
Begin VB.Label Label30
Caption = "%"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 8400
TabIndex = 55
Top = 1680
Width = 255
End
Begin VB.Label Label29
Caption = "重合度"
Height = 255
Left = 7800
TabIndex = 53
Top = 1440
Width = 615
End
Begin VB.Label Label20
Caption = "右片"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4560
TabIndex = 41
Top = 360
Width = 615
End
Begin VB.Label Label1
Caption = "左片"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 0
Top = 360
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'内方位元素
Dim Xo1 As Single, Yo1 As Single, Xo2 As Single, Yo2 As Single
Dim F1 As Single, F2 As Single
'外方位元素
Dim Xs1 As Single, Ys1 As Single, Zs1 As Single, Xs2 As Single, Ys2 As Single, Zs2 As Single
Dim Alf1 As Single, Omg1 As Single, Kp1 As Single, Alf2 As Single, Omg2 As Single, Kp2 As Single
'空间辅助坐标，点投影系数
Dim X1() As Single, Y1() As Single, Z1() As Single, N1() As Single
Dim X2() As Single, Y2() As Single, Z2() As Single, N2() As Single
'同名像对左右片坐标
Dim Ax1() As Single, Ay1() As Single, Ax2() As Single, Ay2() As Single
'同名像对点数
Dim N As Integer
'旋转阵
Dim R1(2, 2) As Integer, R2(2, 2) As Integer
'像片比例尺与重叠度
Dim M As Single, Chong As Single
Dim Bx As Double, By As Double, Bz As Double
Dim Xa As Double, Ya As Double, Za As Double, Q As Double
Dim ptNo As Integer
Dim Data As String
Dim Data1 As String * 1
Dim Item As MSComctlLib.ListItem
Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End Sub
Private Sub Command2_Click()
Xo1 = Val(Text1.Text)
Yo1 = Val(Text2.Text)
F1 = Val(Text3.Text)
Xs1 = Val(Text4.Text)
Ys1 = Val(Text5.Text)
Zs1 = Val(Text6.Text)
Alf1 = Val(Text7.Text)
Omg1 = Val(Text8.Text)
Kp1 = Val(Text9.Text)
R1(0, 0) = Cos(Alf1) * Cos(Kp1) - Sin(Alf1) * Sin(Omg1) * Sin(Kp1)
R1(0, 1) = -Cos(Alf1) * Sin(Kp1) - Sin(Alf1) * Sin(Omg1) * Cos(Kp1)
R1(0, 2) = -Sin(Alf1) * Cos(Omg1)
R1(1, 0) = Cos(Omg1) * Sin(Kp1)
R1(1, 1) = Cos(Omg1) * Cos(Kp1)
R1(1, 2) = -Sin(Omg1)
R1(2, 0) = Sin(Alf1) * Cos(Kp1) + Cos(Alf1) * Sin(Omg1) * Sin(Kp1)
R1(2, 1) = -Sin(Alf1) * Sin(Kp1) + Cos(Alf1) * Sin(Omg1) * Cos(Kp1)
R1(2, 2) = Cos(Alf1) * Cos(Omg1)
End Sub
Private Sub Command3_Click()
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Text18.Text = ""
End Sub
Private Sub Command4_Click()
Xo2 = Val(Text10.Text)
Yo2 = Val(Text11.Text)
F2 = Val(Text12.Text)
Xs2 = Val(Text13.Text)
Ys2 = Val(Text14.Text)
Zs2 = Val(Text15.Text)
Alf2 = Val(Text16.Text)
Omg2 = Val(Text17.Text)
Kp2 = Val(Text18.Text)
R2(0, 0) = Cos(Alf2) * Cos(Kp2) - Sin(Alf2) * Sin(Omg2) * Sin(Kp2)
R2(0, 1) = -Cos(Alf2) * Sin(Kp2) - Sin(Alf2) * Sin(Omg2) * Cos(Kp2)
R2(0, 2) = -Sin(Alf2) * Cos(Omg2)
R2(1, 0) = Cos(Omg2) * Sin(Kp2)
R2(1, 1) = Cos(Omg2) * Cos(Kp2)
R2(1, 2) = -Sin(Omg2)
R2(2, 0) = Sin(Alf2) * Cos(Kp2) + Cos(Alf2) * Sin(Omg2) * Sin(Kp2)
R2(2, 1) = -Sin(Alf2) * Sin(Kp2) + Cos(Alf2) * Sin(Omg2) * Cos(Kp2)
R2(2, 2) = Cos(Alf2) * Cos(Omg2)
End Sub
Private Sub Command7_Click()
M = Val(Text27.Text)
Chong = Val(Text28.Text)
If Option1 = True Then Bx = 18 * M * Chong
If Option2 = True Then Bx = 23 * M * Chong
Xo1 = Val(Text1.Text)
Yo1 = Val(Text2.Text)
F1 = Val(Text3.Text)
Xs1 = Val(Text4.Text)
Ys1 = Val(Text5.Text)
Zs1 = Val(Text6.Text)
Alf1 = Val(Text7.Text)
Omg1 = Val(Text8.Text)
Kp1 = Val(Text9.Text)
R1(0, 0) = Cos(Alf1) * Cos(Kp1) - Sin(Alf1) * Sin(Omg1) * Sin(Kp1)
R1(0, 1) = -Cos(Alf1) * Sin(Kp1) - Sin(Alf1) * Sin(Omg1) * Cos(Kp1)
R1(0, 2) = -Sin(Alf1) * Cos(Omg1)
R1(1, 0) = Cos(Omg1) * Sin(Kp1)
R1(1, 1) = Cos(Omg1) * Cos(Kp1)
R1(1, 2) = -Sin(Omg1)
R1(2, 0) = Sin(Alf1) * Cos(Kp1) + Cos(Alf1) * Sin(Omg1) * Sin(Kp1)
R1(2, 1) = -Sin(Alf1) * Sin(Kp1) + Cos(Alf1) * Sin(Omg1) * Cos(Kp1)
R1(2, 2) = Cos(Alf1) * Cos(Omg1)
Xo2 = Val(Text10.Text)
Yo2 = Val(Text11.Text)
F2 = Val(Text12.Text)
Xs2 = Val(Text13.Text)
Ys2 = Val(Text14.Text)
Zs2 = Val(Text15.Text)
Alf2 = Val(Text16.Text)
Omg2 = Val(Text17.Text)
Kp2 = Val(Text18.Text)
R2(0, 0) = Cos(Alf2) * Cos(Kp2) - Sin(Alf2) * Sin(Omg2) * Sin(Kp2)
R2(0, 1) = -Cos(Alf2) * Sin(Kp2) - Sin(Alf2) * Sin(Omg2) * Cos(Kp2)
R2(0, 2) = -Sin(Alf2) * Cos(Omg2)
R2(1, 0) = Cos(Omg2) * Sin(Kp2)
R2(1, 1) = Cos(Omg2) * Cos(Kp2)
R2(1, 2) = -Sin(Omg2)
R2(2, 0) = Sin(Alf2) * Cos(Kp2) + Cos(Alf2) * Sin(Omg2) * Sin(Kp2)
R2(2, 1) = -Sin(Alf2) * Sin(Kp2) + Cos(Alf2) * Sin(Omg2) * Cos(Kp2)
R2(2, 2) = Cos(Alf2) * Cos(Omg2)
For i = 1 To ptNo
X1(i) = R1(0, 0) * Ax1(i) + R1(0, 1) * Ay1(i) - R1(0, 2) * F1
Y1(i) = R1(1, 0) * Ax1(i) + R1(1, 1) * Ay1(i) - R1(1, 2) * F1
Z1(i) = R1(2, 0) * Ax1(i) + R1(2, 1) * Ay1(i) - R1(2, 2) * F1
X2(i) = R2(0, 0) * Ax2(i) + R2(0, 1) * Ay2(i) - R2(0, 2) * F2
Y2(i) = R2(1, 0) * Ax2(i) + R2(1, 1) * Ay2(i) - R2(1, 2) * F2
Z2(i) = R2(2, 0) * Ax2(i) + R2(2, 1) * Ay2(i) - R2(2, 2) * F2
N1(i) = 1 '(Bx * Z2(i) - Bz * X2(i)) / (X1(i) * Z2(i) - X2(i) * Z1(i))
N2(i) = 1 '(Bx * Z1(i) - Bz * X1(i)) / (X1(i) * Z2(i) - X2(i) * Z1(i))
Xa = M * N1(i) * X1(i)
Ya = M * (N1(i) * Y1(i) + N2(i) * Y2(i) + By) / 2
Za = M * (F1 + N1(i) * Z1(i))
Q = Y1(i) - Y2(i)
Item.Checked = True
ListView1.ListItems(i).SubItems(6) = Format(Val(Xa), "###.####")
ListView1.ListItems(i).SubItems(7) = Format(Val(Ya), "###.####")
ListView1.ListItems(i).SubItems(8) = Format(Val(Za), "###.####")
ListView1.ListItems(i).SubItems(9) = Format(Val(Q), "###.####")
Next i
End Sub
Private Sub Command8_Click()
CommonDialog1.Filter = "文本文件|*.txt"
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
ptNo = 1
ListView1.ListItems.Clear
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Data1 = " "
Data = ""
Do While Asc(Data1) = 32
Data1 = Input(1, #1)
Loop
Do While Asc(Data1) <> 32
Data = Data + Data1
u = Asc(Data1)
If Asc(Data1) = 13 Or EOF(1) Then Exit Do
Data1 = Input(1, #1)
Loop
If EOF(1) Then Exit Do
N = N + 1
If N Mod 4 = 1 Then
Set Item = ListView1.ListItems.Add(ptNo, "N" & ptNo, "")
Item.Checked = True
Item.SubItems(1) = ptNo
Item.SubItems(2) = Val(Data)
ElseIf N Mod 4 = 2 Then
Item.SubItems(3) = Val(Data)
ElseIf N Mod 4 = 3 Then
Item.SubItems(4) = Val(Data)
ElseIf N Mod 4 = 0 Then
Item.SubItems(5) = Val(Data)
ptNo = ptNo + 1
End If
Loop
Close #1
ReDim Ax1(1 To ptNo) As Single
ReDim Ay1(1 To ptNo) As Single
ReDim Ax2(1 To ptNo) As Single
ReDim Ay2(1 To ptNo) As Single
ReDim X1(1 To ptNo) As Single
ReDim Y1(1 To ptNo) As Single
ReDim Z1(1 To ptNo) 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
End Sub
Private Sub Form_Load()
With ListView1.ColumnHeaders
.Clear
.Add 1, "Check", "", 300
.Add 2, "No", "点号", 600
.Add 3, "Lx", "X左片", 945
.Add 4, "Ly", "Y左片", 945
.Add 5, "Rx", "X右片", 945
.Add 6, "Ry", "Y右片", 945
.Add 7, "Xa", "Xa", 945
.Add 8, "Ya", "Ya", 945
.Add 9, "Za", "Za", 945
.Add 10, "Q", "Q", 945
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -