set new UCS in VBA

set new UCS in VBA

Anonymous
Not applicable
2,116 Views
1 Reply
Message 1 of 2

set new UCS in VBA

Anonymous
Not applicable
Who can help me????

I want to change the USC in VBA befor I insert a block.
In LISP is used the following code:
(command "UCS" "X" -57)(command "UCS" "Z" 45)

The result was a ucs that is in the SoudEast posision.
I tryed is to do this in VBA by using de following code:

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

see also below

unfortunately I get a error that the points are not perpendicular.
For the xAxisPoint and the yAxispoint I copyed the coordinates from the
UCSXDIR and the UCSYDIR

What am I dowing wrong hire??

Ore is there a other way to solve my problem?

Regards,

Robert


step 1 is going Oke
step 2 is going wrong




Sub Excample_ActiveUCS()

Dim viewportObj As AcadViewport

Dim ucsObj As AcadUCS

Dim origin(0 To 2) As Double

Dim xAxisPoint(0 To 2) As Double

Dim yAxisPoint(0 To 2) As Double



Set viewportObj = ThisDrawing.ActiveViewport

origin(0) = 0

origin(1) = 0

origin(2) = 0

'STEP 1 rotate UCS on X by -57 degrees

xAxisPoint(0) = 1

xAxisPoint(1) = 0

xAxisPoint(2) = 0



yAxisPoint(0) = 0

yAxisPoint(1) = 0.545

yAxisPoint(2) = -0.839



Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

ThisDrawing.ActiveUCS = ucsObj

'STEP 2 rotate UCS on X by -57 degrees and Z by 45 degrees in one time


xAxisPoint(0) = 0.707

xAxisPoint(1) = 0.385

xAxisPoint(2) = -0.593



yAxisPoint(0) = -0.707

yAxisPoint(1) = 0.385

yAxisPoint(2) = -0.593



Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

ThisDrawing.ActiveUCS = ucsObj

End Sub
0 Likes
2,117 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
nothing your doing wrong, known
problem.

Work around is to set your new UCS
origin at 0,0 with the new vectors. Then
change the origin property of the new
UCS to where you want it.

--
gl - Paul
"Robert K" wrote in message
news:5066335@discussion.autodesk.com...
Who can help me????

I want to change the USC in VBA befor I insert a block.
In LISP is used the following code:
(command "UCS" "X" -57)(command "UCS" "Z" 45)

The result was a ucs that is in the SoudEast posision.
I tryed is to do this in VBA by using de following code:

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

see also below

unfortunately I get a error that the points are not perpendicular.
For the xAxisPoint and the yAxispoint I copyed the coordinates from the
UCSXDIR and the UCSYDIR

What am I dowing wrong hire??

Ore is there a other way to solve my problem?

Regards,

Robert


step 1 is going Oke
step 2 is going wrong




Sub Excample_ActiveUCS()

Dim viewportObj As AcadViewport

Dim ucsObj As AcadUCS

Dim origin(0 To 2) As Double

Dim xAxisPoint(0 To 2) As Double

Dim yAxisPoint(0 To 2) As Double



Set viewportObj = ThisDrawing.ActiveViewport

origin(0) = 0

origin(1) = 0

origin(2) = 0

'STEP 1 rotate UCS on X by -57 degrees

xAxisPoint(0) = 1

xAxisPoint(1) = 0

xAxisPoint(2) = 0



yAxisPoint(0) = 0

yAxisPoint(1) = 0.545

yAxisPoint(2) = -0.839



Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

ThisDrawing.ActiveUCS = ucsObj

'STEP 2 rotate UCS on X by -57 degrees and Z by 45 degrees in one time


xAxisPoint(0) = 0.707

xAxisPoint(1) = 0.385

xAxisPoint(2) = -0.593



yAxisPoint(0) = -0.707

yAxisPoint(1) = 0.385

yAxisPoint(2) = -0.593



Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint,
yAxisPoint, "UCS1")

ThisDrawing.ActiveUCS = ucsObj

End Sub
0 Likes