Hesper186 2024-12-13 07:51 采纳率: 0%
浏览 9

VB三维坐标转换代码显示下标越界

显示下标越界


Dim k3#, Ex#, Ey#, Ez#, dX3#, dY3#, dZ3# '尺度参数,三个旋转参数,三个平移参数
 Dim X3#, Y3#, Z3#, Xx3#, Yy3#, Zz3# '三维坐标转换的正算数值
 '将度.分秒形式化为弧度:输入为度.分秒形式,输出为弧度
Public Function DoToHu(ByVal DoFenMiao As Double) As Single
Const pi As Double = 3.14159265358979
Dim du%, fen%, miao%, angle#
    du = Fix(DoFenMiao)
    DoFenMiao = (DoFenMiao - du) * 100
    fen = Fix(DoFenMiao)
    miao = (DoFenMiao - fen) * 100
    
    angle = du + fen / 60 + miao / 3600
    DoToHu = angle * pi / 180
End Function
'弧度化为度.分秒的形式:输入弧度值,输出度.分秒(各占两位)
Public Function HuToDo(ByVal Hu As Double) As Single
    Const pi As Double = 3.14159265358979
    Dim du%, fen%, miao%
    
    Hu = Hu * 180 / pi
    
    du = Fix(Hu)
    Hu = (Hu - du) * 60
    fen = Fix(Hu)
    Hu = (Hu - fen) * 60
    miao = Fix(Hu + 0.5)
    If miao = 60 Then
        fen = fen + 1
        miao = 0
    End If
    
    HuToDo = du + fen / 100 + miao / 10000
End Function
'矩阵转置的通用过程
Public Sub MatrixTrans(A() As Double, At() As Double)
    Dim i As Integer, j As Integer, rows As Integer, cols As Integer
    rows = UBound(A, 1)
    cols = UBound(A, 2)
    ReDim At(1 To cols, 1 To rows)
    For i = 1 To rows
        For j = 1 To cols
            At(j, i) = A(i, j)
        Next j
    Next i
End Sub
'矩阵相乘:输入矩阵或数Qa、Qb,自动识别它们的维数,并输出它们的乘积Qn
Public Sub Matrix_Multy(C() As Double, A() As Double, b() As Double)
    Dim i As Integer, j As Integer, k As Integer, rowsA As Integer, colsA As Integer, rowsB As Integer, colsB As Integer
    rowsA = UBound(A, 1)
    colsA = UBound(A, 2)
    rowsB = UBound(b, 1)
    colsB = UBound(b, 2)
    ReDim C(1 To rowsA, 1 To colsB)
    For i = 1 To rowsA
        For j = 1 To colsB
            C(i, j) = 0
            For k = 1 To colsA
                C(i, j) = C(i, j) + A(i, k) * b(k, j)
            Next k
        Next j
    Next i
End Sub

' 高斯消元法解线性方程组
Sub MajorInColGuass(A() As Double, b() As Double, x() As Double)
    Dim n As Integer, i As Integer, j As Integer, k As Integer
    Dim maxRow As Integer, temp As Double
    n = UBound(A, 1)
    ReDim x(1 To n)
 
    ' 高斯消元
    For k = 1 To n - 1
        maxRow = k
        For i = k + 1 To n
            If Abs(A(i, k)) > Abs(A(maxRow, k)) Then maxRow = i
        Next i
        If maxRow <> k Then
            For j = k To n
                temp = A(k, j)
                A(k, j) = A(maxRow, j)
                A(maxRow, j) = temp
            Next j
            temp = b(k)
            b(k) = b(maxRow)
            b(maxRow) = temp
        End If
        For i = k + 1 To n
            temp = A(i, k) / A(k, k)
            For j = k + 1 To n
                A(i, j) = A(i, j) - temp * A(k, j)
            Next j
            b(i) = b(i) - temp * b(k)
        Next i
    Next k
 
    ' 回代求解
    For i = n To 1 Step -1
        x(i) = b(i)
        For j = i + 1 To n
            x(i) = x(i) - A(i, j) * x(j)
        Next j
        x(i) = x(i) / A(i, i)
    Next i
End Sub
Private Sub Check1_Click()
 If Check1.Value = 1 Then
        frmCoorTrans.Height = 5175
    ElseIf Check1.Value = 0 Then
        frmCoorTrans.Height = 4440
    End If
End Sub
Private Sub cmdBrowFile_Click()
CommonDialog1.Filter = "*.*"
CommonDialog1.Action = 1
txtFileName.Text = CommonDialog1.FileName
End Sub
Private Sub cmdCalc_Click()
Dim s As String, n As Integer, i As Integer
    Dim x1() As Double, y1() As Double, z1() As Double
    Dim x2() As Double, y2() As Double, z2() As Double
    Dim A() As Double, At() As Double, Naa() As Double, W() As Double, L() As Double
    Dim x(1 To 4) As Double
    Dim Ex As Double, k3 As Double
    Dim du As Integer, fen As Integer
 
    ' 打开文件并读取数据
    Open txtFileName.Text For Input As #1
    Line Input #1, s
    n = Val(s)
    ReDim x1(n), y1(n), z1(n), x2(n), y2(n), z2(n)
 
    For i = 1 To n
        Input #1, x1(i), y1(i), z1(i), x2(i), y2(i), z2(i)
    Next i
    Close #1
 
    ' 初始化矩阵
    ReDim A(1 To 2 * n, 1 To 4)
    ReDim L(1 To 2 * n)
    ReDim At(1 To 4, 1 To 2 * n)
    ReDim Naa(1 To 4, 1 To 4)
    ReDim W(1 To 4)
 
    ' 填充矩阵 A 和 L
    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)
        A(2 * i, 1) = 0: A(2 * i, 2) = 1: A(2 * i, 3) = -z1(i): A(2 * i, 4) = x1(i)
        L(2 * i - 1) = x2(i): L(2 * i) = y2(i)
    Next i
 
    ' 矩阵运算
    MatrixTrans A, At
    Matrix_Multy Naa, At, A
    Matrix_Multy W, At, L
    MajorInColGuass Naa, W, x
 
    ' 分离旋转和尺度参数
    If Abs(x(3)) < 0.00000001 Then
        If x(4) > 0 Then
            Ex = pi / 2
        Else
            Ex = pi * 3 / 2
        End If
    Else
        Ex = Atn(x(4) / x(3))
        If x(3) < 0 And x(4) > 0 Then
            Ex = pi - Ex
        ElseIf x(3) < 0 And x(4) < 0 Then
            Ex = pi + Ex
        ElseIf x(3) > 0 And x(4) < 0 Then
            Ex = pi * 2 + Ex
        End If
    End If
 
    k3 = x(3) / Cos(Ex)
 
    ' 将转换参数写入相应文本框
    txtK3 = Str(k3 - 1)
    Ex = Ex * 180 / pi
    du = Int(Ex): Ex = (Ex - du) * 60
    fen = Int(Ex): Ex = (Ex - fen) * 60
    Ex = Val(Format(Ex, "0.00"))
    Ex = du + fen / 100# + Ex / 10000
    txtEx.Text = Str(Ex)
    textEy.Text = Str(Ey)
    txtEz.Text = Str(Ez)
    txtdX3.Text = Str(x(1))
    txtdY3.Text = Str(x(2))
    txtdZ3.Text = Str(x(3))
End Sub
Private 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 Sub
Private Sub cmdClear3_Click()
txtK3.Text = ""
txtEx.Text = ""
txtEy.Text = ""
txtEz.Text = ""
txtdX3.Text = ""
txtdY3.Text = ""
txtdZ3.Text = ""
txtX3.Text = ""
txtY3.Text = ""
txtZ3.Text = ""
txtXx3.Text = ""
txtYy3.Text = ""
txtZz3.Text = ""
End Sub

Private Sub cmdconCalc3_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)
    Xx3 = Val(txtXx3.Text): Yy3 = Val(txtYy3.Text): Zz3 = Val(txtZz3.Text)
    
    X3 = ((Xx3 - dX3) * Cos(Ey) * Cos(Ez) + (Yy3 - dY3) * (-Cos(Ex) * Sin(Ez) + Sin(Ex) * Sin(Ey) * Cos(Ez)) + _
         (Zz3 - dZ3) * (Sin(Ex) * Sin(Ez) + Cos(Ex) * Sin(Ey) * Cos(Ez))) / (k3 + 1)
    Y3 = ((Xx3 - dX3) * Cos(Ey) * Sin(Ez) + (Yy3 - dY3) * (Sin(Ex) * Sin(Ey) * Sin(Ez) + Cos(Ex) * Cos(Ez)) + _
         (Zz3 - dZ3) * (-Sin(Ex) * Cos(Ez) + Cos(Ex) * Sin(Ey) * Sin(Ez))) / (k3 + 1)
    Z3 = ((Xx3 - dX3) * (-Sin(Ey)) + (Yy3 - dY3) * Sin(Ex) * Cos(Ey) + (Zz3 - dZ3) * (Cos(Ex) * Cos(Ey))) / (k3 + 1)
     
    txtX3.Text = Format(X3, "0.0000")
    txtY3.Text = Format(Y3, "0.0000")
    txtZ3.Text = Format(Z3, "0.0000")
End Sub
Private Sub Command12_Click()
End
End Sub

展开全部

  • 写回答

1条回答 默认 最新

  • 道友老李 JWE233286一种基于机器视觉的水表指针读数识别及修正的方法 专利发明者 2024-12-13 07:57
    关注
    让道友老李来帮你解答,本回答参考通义千问qwen-plus编写提供,如果还有疑问可以评论或留言
    ### 问题分析

    从你提供的代码来看,这是一个 VBA(Visual Basic for Applications)程序,用于处理三维坐标转换。代码中涉及到多个子程序和函数,包括角度转换、矩阵运算、高斯消元法等。你提到的问题是“下标越界”,这通常发生在数组访问时索引超出了数组的边界。

    下标越界的原因

    1. 数组维度不匹配:在定义数组时,如果数组的维度与实际使用的维度不匹配,会导致下标越界。
    2. 循环条件错误:在循环中,如果循环变量的范围设置不当,可能会导致数组索引超出范围。
    3. 动态数组未正确重定义:使用 ReDim 重新定义数组时,如果没有正确地分配内存,也可能导致下标越界。

    代码审查

    让我们逐步检查代码中的关键部分,找出可能导致下标越界的地方。

    1. 读取文件并初始化数组

    Open txtFileName.Text For Input As #1
    Line Input #1, s
    n = Val(s)
    ReDim x1(n), y1(n), z1(n), x2(n), y2(n), z2(n)
    
    For i = 1 To n
        Input #1, x1(i), y1(i), z1(i), x2(i), y2(i), z2(i)
    Next i
    Close #1
    
    • 问题:确保 n 的值是正确的,并且文件中的数据行数与 n 匹配。
    • 解决方案:在读取文件之前,可以添加一些调试信息,确保 n 的值是预期的值。
    Debug.Print "Number of points: " & n
    

    2. 初始化矩阵

    ReDim A(1 To 2 * n, 1 To 4)
    ReDim L(1 To 2 * n)
    ReDim At(1 To 4, 1 To 2 * n)
    ReDim Naa(1 To 4, 1 To 4)
    ReDim W(1 To 4)
    
    • 问题:确保 n 的值是正确的,否则 AL 的维度可能不匹配。
    • 解决方案:在初始化矩阵之前,再次检查 n 的值。
    If n <= 0 Then
        MsgBox "Invalid number of points."
        Exit Sub
    End If
    

    3. 填充矩阵 A 和 L

    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)
        A(2 * i, 1) = 0: A(2 * i, 2) = 1: A(2 * i, 3) = -z1(i): A(2 * i, 4) = x1(i)
        L(2 * i - 1) = x2(i): L(2 * i) = y2(i)
    Next i
    
    • 问题:确保 i 的值在 1n 之间。
    • 解决方案:添加边界检查。
    For i = 1 To n
        If i > UBound(x1) Or i > UBound(y1) Or i > UBound(z1) Or i > UBound(x2) Or i > UBound(y2) Or i > UBound(z2) Then
            MsgBox "Array index out of bounds."
            Exit Sub
        End If
        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)
        A(2 * i, 1) = 0: A(2 * i, 2) = 1: A(2 * i, 3) = -z1(i): A(2 * i, 4) = x1(i)
        L(2 * i - 1) = x2(i): L(2 * i) = y2(i)
    Next i
    

    4. 矩阵运算

    MatrixTrans A, At
    Matrix_Multy Naa, At, A
    Matrix_Multy W, At, L
    MajorInColGuass Naa, W, x
    
    • 问题:确保 AAtNaaWL 的维度匹配。
    • 解决方案:在调用这些函数之前,添加维度检查。
    If UBound(A, 1) <> 2 * n Or UBound(A, 2) <> 4 Then
        MsgBox "Matrix A dimensions are incorrect."
        Exit Sub
    End If
    
    If UBound(At, 1) <> 4 Or UBound(At, 2) <> 2 * n Then
        MsgBox "Matrix At dimensions are incorrect."
        Exit Sub
    End If
    
    If UBound(Naa, 1) <> 4 Or UBound(Naa, 2) <> 4 Then
        MsgBox "Matrix Naa dimensions are incorrect."
        Exit Sub
    End If
    
    If UBound(W, 1) <> 4 Then
        MsgBox "Matrix W dimensions are incorrect."
        Exit Sub
    End If
    
    If UBound(L, 1) <> 2 * n Then
        MsgBox "Matrix L dimensions are incorrect."
        Exit Sub
    End If
    
    MatrixTrans A, At
    Matrix_Multy Naa, At, A
    Matrix_Multy W, At, L
    MajorInColGuass Naa, W, x
    

    案例

    假设我们有一个包含 3 个点的文件 coordinates.txt,内容如下:

    3
    1.0 2.0 3.0 4.0 5.0 6.0
    7.0 8.0 9.0 10.0 11.0 12.0
    13.0 14.0 15.0 16.0 17.0 18.0
    

    运行上述修改后的代码,应该能够正确读取文件并进行坐标转换,而不会出现下标越界错误。

    代码总结

    通过添加边界检查和维度验证,可以有效避免下标越界错误。以下是修改后的关键部分代码:

    Private Sub cmdCalc_Click()
        Dim s As String, n As Integer, i As Integer
        Dim x1() As Double, y1() As Double, z1() As Double
        Dim x2() As Double, y2() As Double, z2() As Double
        Dim A() As Double, At() As Double, Naa() As Double, W() As Double, L() As Double
        Dim x(1 To 4) As Double
        Dim Ex As Double, k3 As Double
        Dim du As Integer, fen As Integer
        
        ' 打开文件并读取数据
        Open txtFileName.Text For Input As #1
        Line Input #1, s
        n = Val(s)
        
        Debug.Print "Number of points: " & n
        
        If n <= 0 Then
            MsgBox "Invalid number of points."
            Exit Sub
        End If
        
        ReDim x1(n), y1(n), z1(n), x2(n), y2(n), z2(n)
        
        For i = 1 To n
            Input #1, x1(i), y1(i), z1(i), x2(i), y2(i), z2(i)
        Next i
        Close #1
        
        ' 初始化矩阵
        ReDim A(1 To 2 * n, 1 To 4)
        ReDim L(1 To 2 * n)
        ReDim At(1 To 4, 1 To 2 * n)
        ReDim Naa(1 To 4, 1 To 4)
        ReDim W(1 To 4)
        
        ' 填充矩阵 A 和 L
        For i = 1 To n
            If i > UBound(x1) Or i > UBound(y1) Or i > UBound(z1) Or i > UBound(x2) Or i > UBound(y2) Or i > UBound(z2) Then
                MsgBox "Array index out of bounds."
                Exit Sub
            End If
            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)
            A(2 * i, 1) = 0: A(2 * i, 2) = 1: A(2 * i, 3) = -z1(i): A(2 * i, 4) = x1(i)
            L(2 * i - 1) = x2(i): L(2 * i) = y2(i)
        Next i
        
        ' 矩阵运算
        If UBound(A, 1) <> 2 * n Or UBound(A, 2) <> 4 Then
            MsgBox "Matrix A dimensions are incorrect."
            Exit Sub
        End If
        
        If UBound(At, 1) <> 4 Or UBound(At, 2) <> 2 * n Then
            MsgBox "Matrix At dimensions are incorrect."
            Exit Sub
        End If
        
        If UBound(Naa, 1) <> 4 Or UBound(Naa, 2) <> 4 Then
            MsgBox "Matrix Naa dimensions are incorrect."
            Exit Sub
        End If
        
        If UBound(W, 1) <> 4 Then
            MsgBox "Matrix W dimensions are incorrect."
            Exit Sub
        End If
        
        If UBound(L, 1) <> 2 * n Then
            MsgBox "Matrix L dimensions are incorrect."
            Exit Sub
        End If
        
        MatrixTrans A, At
        Matrix_Multy Naa, At, A
        Matrix_Multy W, At, L
        MajorInColGuass Naa, W, x
        
        ' 分离旋转和尺度参数
        If Abs(x(3)) < 0.00000001 Then
            If x(4) > 0 Then
                Ex = pi / 2
            Else
                Ex = pi * 3 / 2
            End If
        Else
            Ex = Atn(x(4) / x(3))
            If x(3) < 0 And x(4) > 0 Then
                Ex = pi - Ex
            ElseIf x(3) < 0 And x(4) < 0 Then
                Ex = pi + Ex
            ElseIf x(3) > 0 And x(4) < 0 Then
                Ex = pi * 2 + Ex
            End If
        End If
        
        k3 = x(3) / Cos(Ex)
        
        ' 将转换参数写入相应文本框
        txtK3 = Str(k3 - 1)
        Ex = Ex * 180 / pi
        du = Int(Ex): Ex = (Ex - du) * 60
        fen = Int(Ex): Ex = (Ex - fen) * 60
        Ex = Val(Format(Ex, "0.00"))
        Ex = du + fen / 100# + Ex / 10000
        txtEx.Text = Str(Ex)
        textEy.Text = Str(Ey)
        txtEz.Text = Str(Ez)
        txtdX3.Text = Str(x(1))
        txtdY3.Text = Str(x(2))
        txtdZ3.Text = Str(x(3))
    End Sub
    

    希望这些修改能帮助你解决下标越界的问题。如果有其他问题,请随时提问。

    展开全部

    评论
    编辑
    预览

    报告相同问题?

    手机看
    程序员都在用的中文IT技术交流社区

    程序员都在用的中文IT技术交流社区

    专业的中文 IT 技术社区,与千万技术人共成长

    专业的中文 IT 技术社区,与千万技术人共成长

    关注【CSDN】视频号,行业资讯、技术分享精彩不断,直播好礼送不停!

    关注【CSDN】视频号,行业资讯、技术分享精彩不断,直播好礼送不停!

    客服 返回
    顶部