圆范数

Function UcsM() As Variant
    Dim M(3, 3) As Double
    Dim Orig As Variant
    Orig = ThisDrawing.GetVariable("Ucsorg")
    Dim x, Y, Z
    x = ThisDrawing.GetVariable("UCSXDIR")
    Y = ThisDrawing.GetVariable("UCSYDIR")
    Z = Crossproduct(x, Y)
    M(0, 0) = x(0): M(0, 1) = Y(0): M(0, 2) = Z(0): M(0, 3) = Orig(0)
    M(1, 0) = x(1): M(1, 1) = Y(1): M(1, 2) = Z(1): M(1, 3) = Orig(1)
    M(2, 0) = x(2): M(2, 1) = Y(2): M(2, 2) = Z(2): M(2, 3) = Orig(2)
    M(3, 0) = 0: M(3, 1) = 0: M(3, 2) = 0: M(3, 3) = 1
    
    UcsM = M
    
End Function
'Vectors
Function XYZ(x As Double, Y As Double, Z As Double) As Variant
    Dim P(2) As Double
    P(0) = x: P(1) = Y: P(2) = Z
    XYZ = P
End Function
Function AddVectors(v1, v2) As Variant
    Dim V3(2) As Double
    V3(0) = v1(0) + v2(0)
    V3(1) = v1(1) + v2(1)
    V3(2) = v1(2) + v2(2)
    AddVectors = V3
End Function
Function SubtractVectors(v1, v2) As Variant
    Dim V3(2) As Double
    V3(0) = v1(0) - v2(0)
    V3(1) = v1(1) - v2(1)
    V3(2) = v1(2) - v2(2)
    SubtractVectors = V3
End Function
Function DotProduct(v1, v2)
    Dim V3(2) As Double
    V3(0) = v1(0) * v2(0)
    V3(1) = v1(1) * v2(1)
    V3(2) = v1(2) * v2(2)
    DotProduct = V3
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 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

Dim ucs As AcadUCS
Set ucs = GetActiveUcs
SetOrthoUCS
ent.TransformBy (ThisDrawing.ActiveUCS.GetUCSMatrix)
ThisDrawing.ActiveUCS = ucs