Hesper186 2024-12-13 13:44 采纳率: 0%
浏览 6

三维坐标转换 把文件导入之后总是显示超出文件尾

三维坐标转换 把文件导入之后总是显示超出文件尾

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
        Check1.Height = 5175
    ElseIf Check1.Value = 0 Then
        Check1.Height = 4440
    End If
End Sub
Private Sub cmdBrowFile_Click()
CommonDialog1.Filter = "控制点文件 (*.gcp)|*.gcp|所有文件 (*.*)|*.*"
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)
    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
        If EOF(1) Then
            MsgBox "File ended unexpectedly. Not enough data points."
            Exit Sub
        End If

        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
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条回答 默认 最新

  • 关注

    以下回复参考:皆我百晓生券券喵儿等免费微信小程序作答:

    从你提供的代码和描述来看,似乎是在处理三维坐标转换的问题,可能是从文件读取数据,进行一系列矩阵运算,然后输出结果。你提到的问题是在读取文件后总是显示“超出文件尾”,这可能是因为你尝试读取的数据超出了文件的实际内容。以下是一些可能的原因和解决方案:

    1. 文件内容问题:确保你的输入文件(txtFileName.Text指定的文件)格式正确,并且包含足够的数据点。每个数据点应该包含六个值(x1, y1, z1, x2, y2, z2)。如果文件内容少于预期的数据点数量或格式不正确,就可能出现这个问题。
    2. 文件读取逻辑问题:检查你的文件读取逻辑是否正确。你的代码使用 Line InputInput 来读取数据,确保文件的每一行都有足够的数据供这两个函数使用。如果某一行数据不足,可能会导致读取失败或超出文件尾。
    3. 数组维度问题:确保你定义的数组(如x1, y1, z1等)大小与文件中的数据点数量相匹配。如果数组大小小于数据点数量,那么在读取到文件的末尾时可能会出现问题。
    4. 文件处理错误处理:在你的代码中添加适当的错误处理逻辑,比如当文件读取到末尾或发生其他错误时的处理。这样可以帮助你更好地理解发生了什么,并采取相应的措施。

    为了进一步诊断问题,你可以尝试在关键位置添加打印语句(例如,在读取每个数据点之后),以查看代码实际执行到了哪一步,并检查是否正确地读取了数据。

    如果问题仍然存在,你可能需要更详细地描述你的输入文件内容和格式,以及你期望的输出来帮助进一步分析问题。

    评论
    编辑
    预览

    报告相同问题?

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

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

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

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

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

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

    客服 返回
    顶部