[讨论]：VBA好像没有找到矩阵的例子

雪山飞狐(lzh)

才开始研究矩阵，发个矩阵实现移动、旋转、缩放的例子
三维的矩阵旋转还没想通，应该怎么实现？
或者提供一个矩阵相乘的算法？

[Code]Public Sub Test()
Dim dot(2) As Double
Dim pnt(2) As Double
pnt(0) = 2
pnt(1) = 3
pnt(2) = 3

ScaleByTransMat ThisDrawing.ModelSpace(0), pnt, 10
End Sub

Public Sub RotateByTransMat(ByVal Obj As AcadEntity, ByVal BasePoint As Variant, ByVal Angle As Double)
    Dim pTransMat(3, 3) As Double
    Dim pAngle As Double, pDistance As Double
    pAngle = ThisDrawing.Utility.AngleFromXAxis(pnt, BasePoint)
    pDistance = Sqr(BasePoint(0) ^ 2 + BasePoint(1) ^ 2)
    pTransMat(0, 0) = Cos(Angle): pTransMat(0, 1) = -Sin(Angle): pTransMat(0, 3) = BasePoint(0) - Cos(pAngle + Angle) * pDistance
    pTransMat(1, 0) = Sin(Angle): pTransMat(1, 1) = Cos(Angle): pTransMat(1, 3) = BasePoint(1) - Sin(pAngle + Angle) * pDistance
    pTransMat(2, 2) = 1
    pTransMat(3, 3) = 1
    TestTrans pTransMat
    Obj.TransformBy pTransMat
    Obj.Update
End Sub
Public Sub ScaleByTransMat(ByVal Obj As AcadEntity, ByVal BasePoint As Variant, ByVal ScaleFactor As Double)
    Dim pTransMat(3, 3) As Double
    pTransMat(0, 0) = ScaleFactor: pTransMat(0, 3) = BasePoint(0) * (1 - ScaleFactor)
    pTransMat(1, 1) = ScaleFactor: pTransMat(1, 3) = BasePoint(1) * (1 - ScaleFactor)
    pTransMat(2, 2) = ScaleFactor: pTransMat(2, 3) = BasePoint(2) * (1 - ScaleFactor)
    pTransMat(3, 3) = 1
    TestTrans pTransMat
    Obj.TransformBy pTransMat
    Obj.Update
End Sub

Public Sub MoveByTransMat(ByVal Obj As AcadEntity, ByVal StartPoint As Variant, ByVal EndPoint As Variant)
    Dim pTransMat(3, 3) As Double
    pTransMat(0, 0) = 1: pTransMat(0, 3) = EndPoint(0) - StartPoint(0)
    pTransMat(1, 1) = 1: pTransMat(1, 3) = EndPoint(1) - StartPoint(1)
    pTransMat(2, 2) = 1: pTransMat(2, 3) = EndPoint(2) - StartPoint(2)
    pTransMat(3, 3) = 1
    TestTrans pTransMat
    Obj.TransformBy pTransMat
    Obj.Update
End Sub
Public Sub TestTrans(ByVal TransMat As Variant)
For i = 0 To 3
Debug.Print TransMat(i, 0) & "," & TransMat(i, 1) & "," & TransMat(i, 2) & "," & TransMat(i, 3)
Next i
End Sub[/Code]

efan2000

VBA中提供了相应的平移、旋转、镜像的方法，所以平时比较少用矩阵。

雪山飞狐(lzh)

确实比较少用，不过移动、旋转、缩放的底层还是用矩阵实现的，探讨一下有必要