Well... I wrote the function (Add_UCS_improved) I mentioned in my previous
post, and a test function to demonstrate it.
It solves the problem of the vectors having to be perfectly perpendicular
(by making its own perpendicular Y vector)
I have not thoroughly checked it, though, so if there are errors it could be
due to what Terence mentioned in his post. If that's the case, this could
still be used to make the ucs at the origin, without running into the
perpendicularity problem.
Good luck, check for word-wrap, hope this helps you out.
James
Sub test_Improved_UCS()
' Create a UCS named "New_UCS" in current drawing
Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double
' Define the UCS #1
origin(0) = 4#: origin(1) = 5#: origin(2) = 3#
xAxisPnt(0) = 5#: xAxisPnt(1) = 5#: xAxisPnt(2) = 3#
yAxisPnt(0) = 4.5: yAxisPnt(1) = 6.7: yAxisPnt(2) = 3#
' call the improved ADD function
Set ucsObj = Add_UCS_improved(origin, xAxisPnt, yAxisPnt, "New_UCS")
MsgBox ucsObj.Name & " has been added." & vbCrLf & _
"Origin: " & ucsObj.origin(0) & ", " & ucsObj.origin(1) _
& ", " & ucsObj.origin(2) & vbCrLf & _
"X Axis: " & ucsObj.XVector(0) & ", " & ucsObj.XVector(1) _
& ", " & ucsObj.XVector(2) & vbCrLf & _
"Y Axis: " & ucsObj.YVector(0) & ", " & ucsObj.YVector(1) _
& ", " & ucsObj.YVector(2), , "Add Example"
' Define the UCS #2
origin(0) = 0.1: origin(1) = 0.2: origin(2) = 0.3
xAxisPnt(0) = 0.25: xAxisPnt(1) = 0.1: xAxisPnt(2) = 0.15
yAxisPnt(0) = 0.13: yAxisPnt(1) = -0.06: yAxisPnt(2) = 0.2
' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = Nothing
Set ucsObj = Add_UCS_improved(origin, xAxisPnt, yAxisPnt, "NewUCS#2")
MsgBox ucsObj.Name & " has been added." & vbCrLf & _
"Origin: " & ucsObj.origin(0) & ", " & ucsObj.origin(1) _
& ", " & ucsObj.origin(2) & vbCrLf & _
"X Axis: " & ucsObj.XVector(0) & ", " & ucsObj.XVector(1) _
& ", " & ucsObj.XVector(2) & vbCrLf & _
"Y Axis: " & ucsObj.YVector(0) & ", " & ucsObj.YVector(1) _
& ", " & ucsObj.YVector(2), , "Add Example"
End Sub
Function Add_UCS_improved(origin() As Double, xAxisPnt() _
As Double, yAxisPnt() As Double, ucsName As String) As AcadUCS
' origin, xAxisPnt, and yAxisPnt must all be dimmed (0 to 2)
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