Change UCS Location using VBA

Does anyone know how you can shift the UCS to another point in the coordinate system. I want to be able to pick a point and reference a series a commands generating lines and circles off of this point.

I was tried to use SENDCOMMAND but it didn't work. Im guessing why it didn't work is because the function cannot have variables integrated into its syntax.

So i was trying something like this.

thisdrawing.usercoordinatesystem.add(newpoint,,)
But what i had didn't work. Any ideas?

 

Are the series of commands that you are talking about VBA commands? If so,
they will not be affected by changing the UCS origin, since all coordinates
in VBA are in world CS. But if you're going to change the UCS and then run
script commands, try the Add_UCS_Improved function below, and after calling
the function to create a UCS, use the following line to make it active:

ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("NewUCSname")

http://groups-beta.google.com/group/autodesk.autocad.customization.vba/search?q=add_ucs_improved

james

coordinate system. I want to be able to pick a point and reference a series
a commands generating lines and circles off of this point.

didn't work is because the function cannot have variables integrated into
its syntax.

 

Take a look at the code below:
It sets the ucs the way I want, gets points, transforms throught he current
ucs, then I do some work, then transform them back.

Public Sub Movec(AcadApp As AcadApplication)

Dim Ent As AcadEntity
Dim returnPnt1 As Variant
Dim returnPnt2 As Variant
Dim ssetObj As AcadSelectionSet
Dim fromPoint(0 To 2) As Double
Dim movePoint(0 To 2) As Double
Dim ucsObj As AcadUCS
Dim WCSPnt1 As Variant
Dim WCSPnt2 As Variant
Dim UCSPnt1 As Variant
Dim UCSPnt2 As Variant
Dim currUCS As AcadUCS
Dim fixfrompoint As Variant
Dim fixtopoint As Variant


Set AutoCAD_Application = AcadApp
Set thisdrawing = AutoCAD_Application.ActiveDocument
On Error Resume Next
thisdrawing.SelectionSets("prev").Delete
Set ssetObj = thisdrawing.SelectionSets.Add("prev")
ssetObj.Select acSelectionSetPrevious

thisdrawing.SendCommand "_ucs "
thisdrawing.SendCommand "_v "

Set currUCS = thisdrawing.ActiveUCS

returnPnt1 = thisdrawing.Utility.GetPoint(, "Pick a from point: ")
returnPnt2 = thisdrawing.Utility.GetPoint(, "Pick a to point: ")

For Each Ent In ssetObj

WCSPnt1 = returnPnt1
UCSPnt1 = thisdrawing.Utility.TranslateCoordinates(WCSPnt1, acWorld,
acUCS, False)

WCSPnt2 = returnPnt2
UCSPnt2 = thisdrawing.Utility.TranslateCoordinates(WCSPnt2, acWorld,
acUCS, False)

fromPoint(0) = UCSPnt1(0)
fromPoint(1) = UCSPnt1(1)
fromPoint(2) = 0

movePoint(0) = UCSPnt2(0)
movePoint(1) = UCSPnt2(1)
movePoint(2) = 0

fixfrompoint = thisdrawing.Utility.TranslateCoordinates(fromPoint,
acUCS, acWorld, False)
fixtopoint = thisdrawing.Utility.TranslateCoordinates(movePoint,
acUCS, acWorld, False)

Ent.Move fixfrompoint, fixtopoint
Ent.Update

Next

thisdrawing.SendCommand "_ucs "
thisdrawing.SendCommand "p "

End Sub

This code is copyright 2005, MillLister, Inc. It is posted for example only.
You may use this code if you are not charging for it. If you wish to use
this code in a project you are selling, then please contact me.. I will
issue you a release for free.
--
David Wishengrad
President & CTO
MillLister, Inc.
Software for BOM, measuring, stretching and controlling visibility of
multiple 3D solids.
Http://Construction3D.com
Http://SmartLister.com

coordinate system. I want to be able to pick a point and reference a series
a commands generating lines and circles off of this point.

didn't work is because the function cannot have variables integrated into
its syntax.