VB坐标转换程序设计.doc

Option ExplicitDim k2#, e2#, dX2#, dY2# Dim x2#, Xx2#, y2#, Yy2# Dim k3#, Ex#, Ey#, Ez#, dX3#, dY3#, dZ3# Dim X3#, Y3#, Z3#, Xx3#, Yy3#, Zz3# Const PI = 3.14159265358979Private Sub Check1_Click() If Check1.Value = 1 Then frmCoorTrans.Height = 5175 ElseIf Check1.Value = 0 Then frmCoorTrans.Height = 4440 End IfEnd SubPrivate Sub cmdBrowFile_Click() CDg1.Filter = "控制点文件 (*.gcp)|*.gcp|所有文件 (*.*)|*.*" CDg1.Action = 1 txtFileName.Text = CDg1.FileNameEnd SubPrivate Sub cmdCalc_Click() Dim s As String, iPos%, i%, iCent! Dim n%, x1#(), y1#(), x2#(), y2#() Dim A() As Double, L() As Double, x(1 To 4) As Double Dim At#(), Naa#(), W#() Open txtFileName.Text For Input As #1 Line Input #1, s n = Val(s) ReDim x1#(n), y1#(n), x2#(n), y2#(n) For i = 1 To n Line Input #1, s iPos = InStr(s, ",") x1(i) = Val(Left(s, iPos - 1)) s = Mid(s, iPos + 1) iPos = InStr(s, ",") y1(i) = Val(Left(s, iPos - 1)) s = Mid(s, iPos + 1) iPos = InStr(s, ",") x2(i) = Val(Left(s, iPos - 1)) s = Mid(s, iPos + 1) y2(i) = Val(s) Next i Close #1 '计算转换参数 ReDim A(1 To 2 * n, 1 To 4) As Double, L(1 To 2 * n) As Double ReDim At(1 To 4, 1 To 2 * n), Naa(1 To 4, 1 To 4), W(1 To 4) Debug.Print "系数矩阵A："For i = 1 To n A(2 * i - 1, 1) = 1: A(2 * i - 1, 2) = 0: A(2 * i - 1, 3) = x1(i): A(2 * i - 1, 4) = y1(i) Debug.Print A(2 * i - 1, 1), A(2 * i - 1, 2), A(2 * i - 1, 3), A(2 * i - 1, 4) A(2 * i, 1) = 0: A(2 * i, 2) = 1: A(2 * i, 3) = y1(i): A(2 * i, 4) = -x1(i) Debug.Print A(2 * i, 1), A(2 * i, 2), A(2 * i, 3), A(2 * i, 4) L(2 * i - 1) = x2(i): L(2 * i) = y2(i) Next i Debug.Print "常数向量L：" For i = 1 To 2 * n Debug.Print L(i) Next i MatrixTrans A, At Debug.Print "A的转置矩阵：" ShowMatrix At Matrix_Multy Naa, At, A Debug.Print "Naa：" ShowMatrix Naa Matrix_Multy W, At, L Debug.Print "W：" For i = 1 To 4 Debug.Print W(i) Next i MajorInColGuass Naa, W, x Debug.Print "X" For i = 1 To 4 Debug.Print x(i) Next i '分离旋转和尺度参数 If Abs(x(3)) < 0.00000001 Then If x(4) > 0 Then e2 = PI / 2 Else e2 = PI * 3 / 2 End If Else e2 = Atn(x(4) / x(3)) '得到的是弧度 If x(3) < 0 And x(4) > 0 Then e2 = PI - e2 ElseIf x(3) < 0 And x(4) < 0 Then e2 = PI + e2 ElseIf x(3) > 0 And x(4) < 0 Then e2 = PI * 2 + e2 End If End If k2 = x(3) / Cos(e2) '将转换参数写入相应文本框 txtK2 = Str(k2 - 1) e2 = e2 * 180 / PI Dim du%, fen% du = Int(e2): e2 = (e2 - du) * 60 fen = Int(e2): e2 = (e2 - fen) * 60 e2 = Val(Format(e2, "0.00")) e2 = du + fen / 100# + e2 / 10000 txtE2 = Str(e2) txtdX2.Text = Str(x(1)) txtdY2.Text = Str(x(2))End SubPrivate Sub cmdCalc2_Click() k2 = Val(txtK2.Text) e2 = Val(txtE2.Text) e2 = DoToHu(e2) dX2 = Val(txtdX2.Text) dY2 = Val(txtdY2.Text) x2 = Val(txtX2.Text) y2 = Val(txtY2.Text) Xx2 = (k2 + 1) * (x2 * Cos(e2) + y2 * Sin(e2)) + dX2 Yy2 = (k2 + 1) * (y2 * Cos(e2) - x2 * Sin(e2)) + dY2 txtXx2.Text = Format(Xx2, "0.0000") txtYy2.Text = Format(Yy2, "0.0000")End SubPrivate Sub cmdCalc3_Click() k3 = Val(txtK3.Text) Ex = Val(txtEx.Text) Ex = DoToHu(Ex) Ey = Val(txtEy.Text) Ey = DoToHu(Ey) Ez = Val(txtEz.Text) Ez = DoToHu(Ez) dX3 = Val(txtdX3.Text) dY3 = Val(txtdY3.Text) dZ3 = Val(txtDz3.Text) X3 = Val(txtX3.Text) Y3 = Val(txtY3.Text) Z3 = Val(txtZ3.Text) Xx3 = (k3 + 1) * (X3 * Cos(Ey) * Cos(Ez) + Y3 * Cos(Ey) * Sin(Ez) - Z3 * Sin(Ey)) + dX3 Yy3 = (k3 + 1) * (X3 * (-Cos(Ex) * Sin(Ez) + Sin(Ex) * Sin(Ey) * Cos(Ez)) + Y3 * (Cos(Ex) * Cos(Ez) + Sin(Ex) * Sin(Ey) * Sin(Ez)) + Z3 * (Sin(Ex) * Cos(Ey))) + dY3 Zz3 = (k3 + 1) * (X3 * (Sin(Ex) * Sin(Ez) + Cos(Ex) * Sin(Ey) * Cos(Ez)) + Y3 * (-Sin(Ex) * Cos(Ez) + Cos(Ex) * Sin(Ey) * Sin(Ez)) + Z3 * (Cos(Ex) * Cos(Ey))) + dZ3 txtXx3.Text = Format(Xx3, "0.0000") txtYy3.Text = Format(Yy3, "0.0000") txtZz3.Text = Format(Zz3, "0.0000")End SubPrivate Sub cmdClear2_Click() txtX2.Text = "" txtY2.Text = "" txtXx2.Text = "" txtYy2.Text = ""End SubPrivate Sub cmdClear3_Click() txtX3.Text = "" txtY3.Text = "" txtZ3.Text = "" txtXx3.Text = "" txtYy3.Text = "" txtZz3.Text = ""End Sub。