读取 3D 旋转属性

Option Explicit
Sub TEST()
    Dim b As AcadBlockReference, ent As AcadEntity, V, m
    ThisDrawing.Utility.GetEntity ent, V, "Pick"
    If ent Is Nothing Then Exit Sub
    If Not TypeOf ent Is AcadBlockReference Then Exit Sub
    Set b = ent
    m = BlockRefMatrix(b)
    PrintM m
    
End Sub
Function RotZ(ang As Double) As Variant
   'Rotate by an angle around the z axis
    Dim m
    Dim CosAng As Double, sinAng As Double
    
    CosAng = Cos(ang): sinAng = Sin(ang)
    m = IDMatrix
    m(0, 0) = CosAng
    m(0, 1) = -sinAng
    m(1, 0) = sinAng
    m(1, 1) = CosAng
      
    RotZ = m
End Function
Function M4xM4(M1, M2) As Variant
    'Matrix x matrix
    Dim m(3, 3) As Double
    Dim I As Integer, j As Integer
    Dim k As Integer
    Dim Sum As Double
    
    For I = 0 To 3
        For j = 0 To 3
            For k = 0 To 3
                Sum = Sum + M1(k, j) * M2(I, k)
            Next k
            m(I, j) = Sum
            Sum = 0
        Next j
    Next I
    M4xM4 = m
    
End Function
Function NormaliseVector(V As Variant) As Variant
    Dim Unit As Double
    Dim Vn(2) As Double
    Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
    Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
    NormaliseVector = Vn
End Function
Function Crossproduct(a, b) As Variant
    Dim Ax As Double, Ay As Double, Az As Double
    Dim Bx As Double, By As Double, Bz As Double
    Dim Unit As Double
    Dim c(2) As Double
    'get CrossProduct
    Ax = a(0): Ay = a(1): Az = a(2)
    Bx = b(0): By = b(1): Bz = b(2)
    
    c(0) = Ay * Bz - Az * By
    c(1) = Az * Bx - Ax * Bz
    c(2) = Ax * By - Ay * Bx
    
    'Convert to unit normal
    Unit = Sqr(c(0) * c(0) + c(1) * c(1) + c(2) * c(2))
    c(0) = c(0) / Unit: c(1) = c(1) / Unit: c(2) = c(2) / Unit
    Crossproduct = c
End Function
Function IDMatrix()
    Dim m(3, 3) As Double
    Dim I As Integer, j As Integer
    m(0, 0) = 1
    m(1, 1) = 1
    m(2, 2) = 1
    m(3, 3) = 1
    IDMatrix = m
    
End Function
Sub PrintM(m)
    Dim I As Integer
    Dim j As Integer
    Debug.Print
    If UBound(m, 2) > 3 Then
        For I = 0 To 3
             Debug.Print m(I, 0), m(I, 1), m(I, 2), m(I, 3), m(I, 4), m(I, 5), m(I, 6), m(I, 7)
        Next
    Else
        For I = 0 To 3
             Debug.Print m(I, 0), m(I, 1), m(I, 2), m(I, 3)
        Next
    End If
    
End Sub