1、计算机测绘程序设计代码计算机测绘程序设计实验代码矩阵运算代码：Option Base 1Dim a() As DoubleDim b() As DoubleDim c() As DoublePrivate Sub Command1_Click()Dim n1 As IntegerDim m1 As IntegerDim n2 As IntegerDim m2 As IntegerDim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)m1 = UBound(mystring, 1) - LBo
2、und(mystring, 1)l() = Split(mystring(0), ) 第一行数据n1 = UBound(l, 1) - LBound(l, 1) + 1ReDim a(m1, n1)For i = 1 To m1 l() = Split(mystring(i - 1), ) n1 = UBound(l, 1) - LBound(l, 1) + 1 For j = 1 To n1 a(i, j) = l(j - 1) Next jNext iDim mystring() As StringDim l() As Stringmystring() = Split(Text2.Text
3、, vbCrLf)m1 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), ) 第一行数据n1 = UBound(l, 1) - LBound(l, 1) + 1ReDim b(m1, n1)For i = 1 To m1 l() = Split(mystring(i - 1), ) n1 = UBound(l, 1) - LBound(l, 1) + 1 For j = 1 To n1 b(i, j) = l(j - 1) Next jNext iReDim c(m1, n1)Call madd(a, b,
4、c)Text3.Text = For i = 1 To m1 For j = 1 To n1 Text3.Text = Text3.Text + Str(c(i, j) + Next j Text3.Text = Text3.Text + vbCrLfNext iEnd SubSub madd(mtxA() As Double, mtxB() As Double, mtxC() As Double) 矩阵相加 Dim i As Integer, j As Integer Dim m As Integer, n As Integer m = UBound(mtxA, 1) - LBound(mt
5、xA, 1) + 1 n = UBound(mtxA, 2) - LBound(mtxA, 2) + 1 For i = 1 To n For j = 1 To m mtxC(i, j) = mtxA(i, j) + mtxB(i, j) Text3.Text = mtxC(i, j) Next j Next iEnd Sub角度与弧度的相互转换代码：Public Function jdzh#(jd#, Optional srdw% = 0, Optional scdw% = 0)Const pi# = 3.14159265358979Dim d%, f%, m#, fh%fh = Sgn(j
6、d)jd = Abs(jd)Select Case srdwCase 0d = Int(jd)f = Int(jd - d) * 100)m = (jd - d) * 100 - f) * 100jdzh = d + f / 60 + m / 3600Case 1jdzh = jdCase Elsejdzh = jd * 180 / piEnd SelectSelect Case scdwCase 0jdzh = jdzh * pi / 180 * fhCase 1jdzh = jdzh * fhCase 2jdzh = jdzh * 60 * fhCase 3jdzh = jdzh * 36
7、00 * fhCase Elsed = Int(jdzh)f = Int(jdzh - d) * 60)m = (jdzh - d) * 60 - f) * 60jdzh = d + f / 100 + m / 10000 * fhEnd SelectEnd Function矩阵：Option Base 1Dim A() As DoubleDim B() As DoubleDim C() As DoublePrivate Sub Command1_Click()Text3.Text = Dim i As IntegerDim j As IntegerDim n1 As IntegerDim m
8、1 As IntegerDim n2 As IntegerDim m2 As IntegerDim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)n1 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m1 = UBound(l, 1) - LBound(l, 1) + 1ReDim A(n1, m1)For i = 1 To n1l() = Split(mystring(i - 1), )For j =
9、 1 To m1A(i, j) = l(j - 1)Next jNext imystring() = Split(Text2.Text, vbCrLf)n2 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m2 = UBound(l, 1) - LBound(l, 1) + 1ReDim B(n2, m2)For i = 1 To n2l() = Split(mystring(i - 1), )For j = 1 To m2B(i, j) = l(j - 1)Next jNext iReDim C(n1,
10、 m1)Call madd(A, B, C)For i = 1 To n2 For j = 1 To m2 Text3.Text = Text3.Text + Str(C(i, j) + Next j Text3.Text = Text3.Text + vbCrLfNext i End SubPrivate Sub Command2_Click()Text3.Text = Dim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)n1 = UBound(mystring, 1) - LBound
11、(mystring, 1)l() = Split(mystring(0), )m1 = UBound(l, 1) - LBound(l, 1) + 1ReDim A(n1, m1)For i = 1 To n1l() = Split(mystring(i - 1), )For j = 1 To m1A(i, j) = l(j - 1)Next jNext imystring() = Split(Text2.Text, vbCrLf)n2 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m2 = UBoun
12、d(l, 1) - LBound(l, 1) + 1ReDim B(n2, m2)For i = 1 To n2l() = Split(mystring(i - 1), )For j = 1 To m2B(i, j) = l(j - 1)Next jNext iReDim C(n1, m1)Call mcut(A, B, C)For i = 1 To n2 For j = 1 To m2 Text3.Text = Text3.Text + Str(C(i, j) + Next j Text3.Text = Text3.Text + vbCrLfNext i End SubPrivate Sub
13、 Command3_Click()Text3.Text = Dim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)n1 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m1 = UBound(l, 1) - LBound(l, 1) + 1ReDim A(n1, m1)For i = 1 To n1l() = Split(mystring(i - 1), )For j = 1 To m1A(i, j)
14、= l(j - 1)Next jNext imystring() = Split(Text2.Text, vbCrLf)n2 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m2 = UBound(l, 1) - LBound(l, 1) + 1ReDim B(n2, m2)For i = 1 To n2l() = Split(mystring(i - 1), )For j = 1 To m2B(i, j) = l(j - 1)Next jNext iReDim C(n1, m1)Call mmul(A,
15、 B, C)For i = 1 To n2 For j = 1 To m2 Text3.Text = Text3.Text + Str(C(i, j) + Next j Text3.Text = Text3.Text + vbCrLfNext i End SubPrivate Sub Command4_Click()Text3.Text = Dim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)n1 = UBound(mystring, 1) - LBound(mystring, 1)l()
16、 = Split(mystring(0), )m1 = UBound(l, 1) - LBound(l, 1) + 1ReDim A(n1, m1)For i = 1 To n1l() = Split(mystring(i - 1), )For j = 1 To m1A(i, j) = l(j - 1)Next jNext iReDim C(n1, m1)Call MRinv(A)For i = 1 To n1 For j = 1 To m1 Text3.Text = Text3.Text + Str(Format(A(i, j), 0.0000) + Next j Text3.Text =
17、Text3.Text + vbCrLfNext i End SubPrivate Sub Command5_Click()Text3.Text = Dim AT() As DoubleDim mystring() As StringDim l() As Stringmystring() = Split(Text1.Text, vbCrLf)n1 = UBound(mystring, 1) - LBound(mystring, 1)l() = Split(mystring(0), )m1 = UBound(l, 1) - LBound(l, 1) + 1ReDim A(n1, m1)For i
18、= 1 To n1l() = Split(mystring(i - 1), )For j = 1 To m1A(i, j) = l(j - 1)Next jNext iReDim AT(m1, n1)Call Mtrans(A, AT)For i = 1 To n1 For j = 1 To m1 Text3.Text = Text3.Text + Str(Format(AT(i, j), 0.0000) + Next j Text3.Text = Text3.Text + vbCrLfNext i End SubSub madd(mtxA() As Double, mtxB() As Dou
19、ble, mtxC() As Double) 矩阵相加 Dim i As Integer, j As Integer Dim m As Integer, n As Integer m = UBound(mtxA, 1) - LBound(mtxA, 1) + 1 n = UBound(mtxA, 2) - LBound(mtxA, 2) + 1 For i = 1 To n For j = 1 To m mtxC(i, j) = mtxA(i, j) + mtxB(i, j) Next j Next iEnd SubSub mcut(mtxA() As Double, mtxB() As Do
20、uble, mtxC() As Double) 矩阵相减 Dim i As Integer, j As Integer Dim m As Integer, n As Integer m = UBound(mtxA, 1) - LBound(mtxA, 1) + 1 n = UBound(mtxA, 2) - LBound(mtxA, 2) + 1 For i = 1 To n For j = 1 To m mtxC(i, j) = mtxA(i, j) - mtxB(i, j) Next j Next iEnd SubSub Mtrans(mtxA() As Double, mtxAT() A
21、s Double) 矩阵转置 Dim i As Integer, j As Integer Dim m As Integer, n As Integer m = UBound(mtxA, 1) - LBound(mtxA, 1) + 1 n = UBound(mtxA, 2) - LBound(mtxA, 2) + 1 For i = 1 To n For j = 1 To m mtxAT(i, j) = mtxA(j, i) Next j Next iEnd SubSub mmul(mtxA() As Double, mtxB() As Double, mtxC() As Double) 矩
22、阵相乘Dim m As IntegerDim n As IntegerDim l As IntegerDim i As Integer, j As Integer, K As Integerm = UBound(mtxA, 1) - LBound(mtxA, 1) + 1n = UBound(mtxA, 2) - LBound(mtxA, 2) + 1l = UBound(mtxB, 2) - LBound(mtxB, 2) + 1For i = 1 To m For j = 1 To l mtxC(i, j) = 0# For K = 1 To n mtxC(i, j) = mtxC(i,
23、j) + mtxA(i, K) * mtxB(K, j) Next K Next jNext iEnd SubFunction MRinv(mtxA() As Double) As Boolean 矩阵求逆Dim n As Integern = UBound(mtxA, 1) - LBound(mtxA, 1) + 1ReDim nIs(0 To n) As Integer, nJs(0 To n) As IntegerDim i As Integer, j As Integer, K As IntegerDim D As Double, p As DoubleFor K = 1 To nD
24、= 0#For i = K To n For j = K To n p = Abs(mtxA(i, j) If (p D) Then D = p nIs(K) = i nJs(K) = j End IfNext jNext iIf (D + 1# = 1#) Then MRinv = False Exit FunctionEnd IfIf (nIs(K) K) Then For j = 1 To n p = mtxA(K, j) mtxA(K, j) = mtxA(nIs(K), j) mtxA(nIs(K), j) = p Next jEnd IfIf (nJs(K) K) Then For
25、 i = 1 To n p = mtxA(i, K) mtxA(i, K) = mtxA(i, nJs(K) mtxA(i, nJs(K) = p Next iEnd IfmtxA(K, K) = 1# / mtxA(K, K)For j = 1 To n If (j K) Then mtxA(K, j) = mtxA(K, j) * mtxA(K, K)Next jFor i = 1 To n If (i K) Then For j = 1 To n If (j K) Then mtxA(i, j) = mtxA(i, j) - mtxA(i, K) * mtxA(K, j) Next j
26、End IfNext iFor i = 1 To n If (i K) Then mtxA(i, K) = -mtxA(i, K) * mtxA(K, K)Next iNext KFor K = n To 1 Step -1 If (nJs(K) K) Then For j = 1 To n p = mtxA(K, j) mtxA(K, j) = mtxA(nJs(K), j) mtxA(nJs(K), j) = p Next jEnd IfIf (nIs(K) K) ThenFor i = 1 To n p = mtxA(i, K) mtxA(i, K) = mtxA(i, nIs(K) mtxA(i, nIs(K) = pNext iEnd IfNext KMRinv = TrueEnd Function
