Help with UCS

Hello

What I was able to do in older ACAD versions and VBA I seem to be having great difficulty with. For the code below I simply wanted to draw a circle at 0,0,0 and then move the UCS to a new location, and draw another circle at 0,0,0, but this time relative to the new UCS location.

Rob Johnston

{Code Start}
Sub newUCS()
Dim circleObj As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius As Double

centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
radius = 5#

' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
circleObj.color = acGreen

' 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
origin(0) = 4#: origin(1) = 5#: origin(2) = 3#
xAxisPnt(0) = 5#: xAxisPnt(1) = 5#: xAxisPnt(2) = 3#
yAxisPnt(0) = 4#: yAxisPnt(1) = 6#: yAxisPnt(2) = 3#

' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
ThisDrawing.ActiveUCS = ucsObj

centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
radius = 5#

ThisDrawing.ActiveUCS = ucsObj
' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
circleObj.color = acBlue

End Sub

{Code End}

 

Hi Rob

'AddCircle' method requires a point expressed in WCS coordinates.
Therefore you've to translate the point from UCS to WCS coordinates by
'TranslateCoordinates':

Code:

Sub newUCS()

Dim NewPnt As Variant

'...

' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, _
yAxisPnt, "New_UCS")
ThisDrawing.ActiveUCS = ucsObj
centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
radius = 5#
NewPnt = ThisDrawing.Utility.TranslateCoordinates(centerPoint, acUCS, _
acWorld, False)
' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(NewPnt, radius)
circleObj.Color = acBlue
End Sub

Cheers

 

Or, draw it to the WCS and then modify its NORMAL property - depending upon
what you're doing.

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...