New UCS by 3 points in VBA - the solution

[KevinBarnett]

Greetings Gang,

Experienced guys probably know this already, so please forgive the repetition - I think this will be really useful to the newbies out there.

If you have never tried to make a UCS in VBA then you MUST read this before you do - or... go ahead and struggle for a while, then come back for the solution.

When you try to add UCS's you will (more than likely hit this error):
"UCS X axis and Y axis not perpendicular"

I struggled for a short while, then decided to search the discussion groups and found a jewel.

The solution was found under:
http://discussion.autodesk.com/forum.jspa?forumID=33
(otherwise known as the VBA Customization discussion group)

The title of the thread was:
The UCS X axis and Y axis are not perpendicular ???
Posted by: Dubbelaar, Mark
Date: Jun/10/03 - 19:46 (GMT)

The solution was suplied in this reply:
Reply From: Belshan, James
Date: Jun/11/03 - 09:24 (GMT)

When you want to add a ucs dont use ThisDrawing.UserCoordinateSystems.Add! Instead use:

Set AcadUcsObject = Add_UCS_improved(PointVariantOrigin, PointVariantXAxis, PointVariantYAxis, "UCSName")

and include this code:

Function Add_UCS_improved(origin As Variant, xAxisPnt _
    As Variant, yAxisPnt As Variant, ucsName As String) As AcadUCS

    Dim ucsObj As AcadUCS
    Dim xAxisVec(0 To 2) As Double
    Dim yAxisVec(0 To 2) As Double
    Dim perpYaxisPnt(0 To 2) As Double
    Dim xCy As Variant, perpYaxisVec As Variant
    
    xAxisVec(0) = xAxisPnt(0) - origin(0)
    xAxisVec(1) = xAxisPnt(1) - origin(1)
    xAxisVec(2) = xAxisPnt(2) - origin(2)
    yAxisVec(0) = yAxisPnt(0) - origin(0)
    yAxisVec(1) = yAxisPnt(1) - origin(1)
    yAxisVec(2) = yAxisPnt(2) - origin(2)
    
    xCy = Cross3D(xAxisVec, yAxisVec)
    perpYaxisVec = Cross3D(xCy, xAxisVec)
    
    perpYaxisPnt(0) = perpYaxisVec(0) + origin(0)
    perpYaxisPnt(1) = perpYaxisVec(1) + origin(1)
    perpYaxisPnt(2) = perpYaxisVec(2) + origin(2)
    
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, _
        perpYaxisPnt, ucsName)
    Set Add_UCS_improved = ucsObj

End Function

Function Cross3D(A As Variant, B As Variant) As Variant
    ' A and B must be dimensioned Double(0 to 2)
    Dim C(0 To 2) As Double
    C(0) = A(1) * B(2) - A(2) * B(1)
    C(1) = -(A(0) * B(2) - A(2) * B(0))
    C(2) = A(0) * B(1) - A(1) * B(0)
    Cross3D = C
End Function

THANK YOU JAMES!!!!

Have a great day,

Kevin.