acad的向量/矩阵函数

'''''''''------- Vector Methods --------------'''''''''''
Public Function VecNorm(vec() As Double) As Double()
'Normalises the incoming vector.
Dim vecn(2) As Double
Dim unit As Double
unit = Sqr(vec(0) * vec(0) + vec(1) * vec(1) + vec(2) * vec(2))
vecn(0) = vec(0) / unit: vecn(1) = vec(1) / unit: vecn(2) = vec(2) / unit
VecNorm = vecn
End Function
Function VecCross(v1() As Double, v2() As Double) As Variant
    Dim vec(2)
    vec(0) = v1(1) * v2(2) - v2(1) * v1(2)
    vec(1) = v1(2) * v2(0) - v2(2) * v1(0)
    vec(2) = v1(0) * v2(1) - v2(0) * v1(1)
    VecCross = vec
End Function
'''''''''--------- Matrix Methods ------------'''''''''''
Public Function xFormMat(vx() As Double, vy() As Double, vz() As Double) As Variant
'Uses the incoming vectors to transform the entity being passed in
Dim mat(0 To 3, 0 To 3) As Double
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
xFormMat = mat
End Function
Public Function GetMatFromLine(line As AcadLine) As Variant
'builds a matrix based on the line's sp, ep and normal
Dim mat(0 To 3, 0 To 3) As Double
Dim vx(2) As Double, vy(2) As Double, vz(2) As Double
'get the lines ep-sp vector to create the z axis:
vz(0) = line.EndPoint(0) - line.StartPoint(0)
vz(1) = line.EndPoint(1) - line.StartPoint(1)
vz(2) = line.EndPoint(2) - line.StartPoint(2)
'normalise it:
Dim retvec As Variant
retvec = VecNorm(vz)
vz(0) = retvec(0): vz(1) = retvec(1): vz(2) = retvec(2)
'get the line's normal for the x vector:
vx(0) = line.Normal(0)
vx(1) = line.Normal(1)
vx(2) = line.Normal(2)
'create the y vector by xproduct of z over x:
retvec = VecCross(vz, vx)
vy(0) = retvec(0): vy(1) = retvec(1): vy(2) = retvec(2)
'normalise it:
retvec = VecNorm(vy)
vy(0) = retvec(0): vy(1) = retvec(1): vy(2) = retvec(2)
'plug 'em into the matrix:
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
GetMatFromLine = mat
End Function

Option Explicit
Type TPoint
    X As Double
    Y As Double
    Z As Double
End Type
Type TLine
    P1 As TPoint
    P2 As TPoint
End Type
Sub Demo ( )
    Dim P1 As TPoint, _
        P2 As TPoint
    With P1
        .X = 20
        .Y = 20
    End With
    
    ''  Set P2 = P1, remembering it's a copy of the data.
    ''  Not the same as setting one object to another.
    ''  If you're a .NET geek think of UDTs as value types
    ''  (as opposed to reference types).
    
    P2 = P1
    
    ''  Show P2's data
    With P2
        Debug.Print "P2's initial data:"
        Debug.Print "P2.X ="; .X; ", P2.Y = "; .Y
        Debug.Print
    End With
    
    ''  prove P2 is not a pointer to P1 by assigning new 
    ''  data to P1 and reprinting P2's data
    
    With P1
        .X = 10
        .Y = 10
    End With
    ''  show p2's data again (ha, still 20, 20)
    With P2
        Debug.Print "P2's data after P1 given new values:"
        Debug.Print "P2.X ="; .X; ", P2.Y = "; .Y
        Debug.Print
    End With
    
    ''  now demonstrate a deeper copy
    
    Dim L1 As TLine, _
        L2 As TLine
        
    ''  initialize L1 using previously defined P1 and P2
    
    With L1
        .P1 = P1
        .P2 = P2
    End With
    
    ''  now force L2 to have a copy of L1's data (the deeper copy)
    
    L2 = L1
    
    ''  show L2's data
    
    With L2
        Debug.Print "L2's data:"
        Debug.Print "L2, P1.x = "; .P1.X; " , P1.y = "; .P1.Y
        Debug.Print "L2, P2.x = "; .P2.X; " , P2.y = "; .P2.Y
    End With
    
    ''  ha, cool you say; not too shabby for vb.
End Sub

Sub Test()
    Dim A1(2) As Double
    Dim A2() As Double
    Dim A3() As Double
    Dim Var As Variant
    
    
    A1(0) = 1: A1(1) = 1: A1(2) = 2
    A2() = A1()
    
    Var = A1()
    
    A3() = Var
    
  
   
End Sub