Message 1 of 2
set new UCS in VBA

Not applicable
01-23-2006
12:12 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
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