Saturday, February 20, 2010

Make VBA modify the UCS

I've spent a lot of time scouring the internet on how to program VBA in AutoCad and Excel and both. What I've found is that despite all the resources out there I had to figure a lot of things out on my own. Well, for the remaining year while AutoCad still offers VBA support I thought I would wholesale post everything. Today's lesson: Understand the Acad UCS and make VBA change it for you.

Ok, so first off, there are a lot of different code bits you can dig up if you type in VBA and UCS into google, most of the ones I found to be inadequate or just wrong. What I wanted was a function that could take a line and rotate the UCS based on that startpoint of that line. There is no such code you will find on the inter-webs. Except here.

Things to remember:
  1. The UCS is manipulated by the X, Y and origin coordinates only. If you want to rotate the on the Z axis change the location of the z coordinate in the X/Y vector
  2. The X and Y vectors must be perpendicular to one another. If your X and Y are not perpendicular then you get an ugly error message and you are attempting to use a non rectangular coordinate system which doesn't really exist.
  3. Understand How the Trigonometric Functions in different quadrants affect what you are doing.
  4. The UCS is comprised of an X,Y and Z vector that is defined by the X, Y and Origin point.
For this code to work you need an origin point and a X(x,y,z) and a Y(x,y,z)

For my purposes I wrote some code that selects lines in a drawing and uses the origin point of the line to rotate the the UCS.

First you need to Dimension some variables:

Dim Origin(2) As Double 'origin array
Dim xAxisPNT(2) As Double 'xaxis point
Dim yAxisPNT(2) As Double 'yaxis point
Dim Rotation as double 'the rotation angle of the line
Dim bSIN As Double
Dim bCOS As Double
Dim bTAN As Double
Dim ucsObj As AcadUCS

bSIN = Sin(rotation)
bCOS = Cos(rotation)
bTAN = Tan(rotation)

All you need here is the ORIGIN Point and the rotation of the line, (I'll cover selecting the line in a later post) here's the math:
NOTE: ABS value was used for all the formulas, even though it was _
not needed for all the formulas. _

select case TRUE

'case quadrant I, all functions are positive
Case bSIN > 0 And bCOS > 0 And bTAN > 0
xAxisPNT(0) = Origin(0) + 1 * Cos(rotation) 'x1
xAxisPNT(1) = Origin(1) + 1 * Sin(rotation) 'y1
yAxisPNT(0) = Origin(0) - 1 * Sin(rotation) 'x2
yAxisPNT(1) = Origin(1) + 1 * Cos(rotation) 'y2
'case quadrant II, sine is positive
Case bSIN > 0 And bCOS <>
'quadrant II rotation x,y
xAxisPNT(0) = Origin(0) - 1 * Abs(Cos(rotation)) 'x
xAxisPNT(1) = Origin(1) + 1 * Abs(Sin(rotation)) 'y
yAxisPNT(0) = Origin(0) - 1 * Abs(Sin(rotation)) 'x2
yAxisPNT(1) = Origin(1) - 1 * Abs(Cos(rotation)) 'y2

'case quadrant III, tan is positive
Case bSIN <> 0
'quadrant III rotation x,y
xAxisPNT(0) = Origin(0) - 1 * Abs(Cos(rotation)) 'x2
xAxisPNT(1) = Origin(1) - 1 * Abs(Sin(rotation)) 'y2
yAxisPNT(0) = Origin(0) - 1 * Abs(Sin(rotation)) 'x
yAxisPNT(1) = Origin(1) + 1 * Abs(Cos(rotation)) 'y

'case quadrant IV, cosine is posistive
'quadrant III rotation x,z
Case bSIN <> 0 And bTAN <>
'quadrant IV rotation x,y
xAxisPNT(0) = Origin(0) + 1 * Abs(Cos(rotation)) 'x
xAxisPNT(1) = Origin(1) - 1 * Abs(Sin(rotation)) 'y
yAxisPNT(0) = Origin(0) + 1 * Abs(Sin(rotation)) 'x2
yAxisPNT(1) = Origin(1) + 1 * Abs(Cos(rotation)) 'y2

'case rotation = 180
Case bCOS = -1
'x,y
xAxisPNT(0) = Origin(0) - 1
xAxisPNT(1) = Origin(1)
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1) - 1
'case rotation = 90
Case bSIN = 1
'x,y
xAxisPNT(0) = Origin(0)
xAxisPNT(1) = Origin(1) + 1
yAxisPNT(0) = Origin(0) - 1
yAxisPNT(1) = Origin(1)

'case rotation = 270
Case bSIN = -1
xAxisPNT(0) = Origin(0)
xAxisPNT(1) = Origin(1) - 1
yAxisPNT(0) = Origin(0) + 1
yAxisPNT(1) = Origin(1)

End select
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add _
(Origin, xAxisPNT, yAxisPNT, "New_UCS")
ThisDrawing.ActiveUCS = ucsObj

And that's it for X, Y... however, I wanted to rotate to the X, Z so my cases were slightly different:

Select Case True
'case rotation = 0
Case bCOS = 1
'X,Z
xAxisPNT(0) = Origin(0) + 1
xAxisPNT(1) = Origin(1)
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1

'case rotation = 180
Case bCOS = -1
'x,z
xAxisPNT(0) = Origin(0) - 1
xAxisPNT(1) = Origin(1)
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1

'case rotation = 90
Case bSIN = 1
'x,z
xAxisPNT(0) = Origin(0)
xAxisPNT(1) = Origin(1) + 1
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1

'case rotation = 270
Case bSIN = -1
xAxisPNT(0) = Origin(0)
xAxisPNT(1) = Origin(1) - 1
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1

'case quadrant I, all functions are positive
Case bSIN > 0 And bCOS > 0 And bTAN > 0
'Quadrant I rotation, x,z
xAxisPNT(0) = Origin(0) + 1 * Cos(rotation) 'x1
xAxisPNT(1) = Origin(1) + 1 * Sin(rotation) 'y1
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1 * Cos(rotation) 'y2

'case quadrant II, sine is positive
Case bSIN > 0 And bCOS <>
'quadrant II rotation x,z
xAxisPNT(0) = Origin(0) - 1 * Abs(Cos(rotation)) 'x
xAxisPNT(1) = Origin(1) + 1 * Abs(Sin(rotation)) 'y
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) - 1 * Abs(Cos(rotation)) 'y2

'case quadrant III, tan is positive
Case bSIN <> 0
'quadrant III rotation x,z
xAxisPNT(0) = Origin(0) - 1 * Abs(Cos(rotation)) 'x2
xAxisPNT(1) = Origin(1) - 1 * Abs(Sin(rotation)) 'y2
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1 * Abs(Cos(rotation)) 'y

'case quadrant IV, cosine is posistive
Case bSIN <> 0 And bTAN <>
'quadrant IV rotation x,z
xAxisPNT(0) = Origin(0) + 1 * Abs(Cos(rotation)) 'x
xAxisPNT(1) = Origin(1) - 1 * Abs(Sin(rotation)) 'y
yAxisPNT(0) = Origin(0)
yAxisPNT(1) = Origin(1)
yAxisPNT(2) = Origin(1) + 1 * Abs(Cos(rotation)) 'y2
End Select

Hopefully that demystifies the UCS a little. Feel Free to use this code, modify it, bend it to your will, just let me know! And feel free to email me with any questions or comments!

Pennington.Pennington@Gmail.com

Copyright 2010 SolidStateBrains



No comments:

Post a Comment