Errors creating UCS objects

Hi all, congrats on making it to the end of another week of programming.

I am trying to create new UCS objects and keep getting errors. I need to do
some dimensioning in views perpendicular to the WCS. ie right, left,
front...

I kept getting an error when trying to create a rotated UCS, so I decided
just to try moving the ucs and using the same vectors.. No luck there
either...


Set ucsObj = ThisDrawing.ActiveUCS' which is WCS
origin(0) = 1
origin(1) = 0
origin(2) = 0
Set newUcsObj = ThisDrawing.UserCoordinateSystems.Add _
(origin, ucsObj.XVector, ucsObj.YVector, "testUCS")

This gives me an error stating "The UCS x-axis point coincides the UCS
origin"
If I switch X and Y values above I get same error for y-axis.

If I change the origin points to something like...
origin(0) = 0
origin(1) = 5.5
origin(2) = 0

I get an error stating "The UCS x-axis and y-axis are not perpendicular"?

What am I doing wrong?

TFYT,

Paul

 

Hi Paul

There is a precision problem...
James Belshan posted this a while ago (06/11/03):

Code:

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

Cheers

 

Juerg,

And James..Thanks..wish I had posted sooner..messed with it for a few days.

Cheers,

Paul

 

Welcome...

Cheers

 

Paul,
Please write back whether this routine actually is an improvement over the
normal AddUCS method. It seemed to be helpful (create UCS's with inputs
that would choke the normal AddUCS method) when I wrote it, but it has
gotten mixed reviews from different people who tried it.

James

 

btw..the Pre-Suf fix's on the dims are
L left, M male, S standard, D door, ect....

The sample front elev I sent has a few RS right standard cuts, that should
be
RD right door....in case you were wondering...

Cheers,

Paul

 

Hi Paul

Another workaround:
Create the UCS at 0,0,0 origin and after that change the UCS origin
coordinates to the current point.

Cheers

 

James, Thanks for your help...works great. Sorry for the rambling this
morning,
was mostly talking to myself..didn't realize how long it was till I read
after posting. Even I didn't want to read it...Ha..

Cheers,
Paul

 

Sorry for the rambling this morning,

No apology necessary. I just meant that I couldn't help you with the other
parts of your question (Lisp vs VBA, etc). I could only tackle the one
point, the UCS issue, and leave the other parts up to others.

Good luck,

James