TheSwamp
Code Red => VB(A) => Topic started by: Bryco on August 02, 2007, 07:21:56 PM

I knew that a circle will take the current ucs normal when being inserted but I didn't know it also took that normal when being added to the block record.
I guess the answer is to set the active ucs to world before creating any block with vba.
Somewhat tedious.
Any better ideas?

You should be able to calculate the normal in wcs terms given the current ucs normal you are using, same as getting points can sometimes trip you up with different ucs's, the bt record only sees the normal in the current ucs context which is quite different to wcs.

So either I set every objects normal or I make world current, it's probably a wash.
Mick is this happen in C# as well?

yes, and ARX.
The db does not know the difference between a normal in a ucs or a wcs, it's just a value but all values are stored as 'world' values so when everything gets drawn it doesn't need to change between ucs's for every object that was created in a different ucs if that makes sense.
Either way you will need to calculate your normal or orientation in space, ie. even if you do set ucs to world you still need to calculate the >rotated< normal in wcs before you add your circle to the db.
edit: clarified that normal needed is the rotated from world normal

Thanks for the reply,
actually if I make Wcs current the normal is fine (0,0,1).
The blockref also receives the ucs normal when inserted so I was looking at working out the rotation and leaving the normal as is. The math is a bit tricky (I can see it all but I seem to need a matrix so it's not worth while) so I think I'll insert it set the normal to 0,0,1 then transform it using the ucs matrix. It's the easy solution but I wouldn't say the best.

In case someone knows the math. The rotation would be found by transforming the ucs xdir vector from the ucs normal (crossproduct x and y) to a world normal, then comparing the new vector angle to the world x axis.

it sounds like you need to do what you said in the op, create the block in wcs then xform it to its required position, this is good practice anyway and keeps the original math simple. If you can get the destination ucs when inserting the block it will be easy 
create block @ origin,
get current ucs (or similar)
build matrix with ucs
xform block and done.
hth

Good advice Mick.
As an insert function the following works fine, but I do have to change the insertion point later (oBref.InsertionPoint = insPt), don't know why.
Function InsertBlockref(Space As AcadBlock, insPt As Variant, sName As String, Optional Sc As Double = 1, Optional Rot As Double = 0) As AcadBlockReference
Dim oBref As AcadBlockReference
Dim Zero(2) As Double
Dim N(2) As Double, oUcs As AcadUCS
Dim Att
Set oBref = Space.InsertBlock(Zero, sName, Sc, Sc, Sc, Rot)
If ThisDrawing.GetVariable("Worlducs") = 1 Then
Set InsertBlockref = oBref
Exit Function
End If
N(2) = 1
oBref.Normal = N
If oBref.HasAttributes Then
For Each Att In oBref.GetAttributes
Att.Normal = N
Next Att
End If
Set oUcs = GetActiveUcs
oBref.TransformBy oUcs.GetUCSMatrix
oBref.InsertionPoint = insPt
Set InsertBlockref = oBref
End Function
and a function
Function GetActiveUcs() As AcadUCS
Dim Origin
Dim Xaxis
Dim Yaxis
Dim strNm As String, sUcs As String
sUcs = ThisDrawing.GetVariable("UCSNAME")
If sUcs = "" Then
' Current UCS is not saved so get the data and save it
'A ucs is saved when a user makes and saves one or
' a user clicks on an isoview button
With ThisDrawing
If .GetVariable("WORLDUCS") = 1 Then
Xaxis = Zero: Yaxis = Zero
Xaxis(0) = 1: Yaxis(1) = 1
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "World")
Exit Function
End If
Origin = .GetVariable("UCSORG")
Xaxis = .GetVariable("UCSXDIR")
Yaxis = .GetVariable("UCSYDIR")
strNm = "Active"
End With
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, strNm)
'Changing the origin later stops the error message
'2145320930 UCS X axis and Y axis are not perpendicular
GetActiveUcs.Origin = Origin
ThisDrawing.ActiveUCS = GetActiveUcs
Else
Select Case sUcs
Case "*TOP*", "TOP"
Set GetActiveUcs = SetOrthoUCS("Top")
Case "*BOTTOM*"
Set GetActiveUcs = SetOrthoUCS("Bottom")
Case "*LEFT*"
Set GetActiveUcs = SetOrthoUCS("Left")
Case "*RIGHT*"
Set GetActiveUcs = SetOrthoUCS("Right")
Case "*FRONT*"
Set GetActiveUcs = SetOrthoUCS("Front")
Case "*BACK*"
Set GetActiveUcs = SetOrthoUCS("Back")
Case Else
Set GetActiveUcs = ThisDrawing.ActiveUCS 'current UCS is saved
End Select
End If
End Function

Hi Bryco, thought I'd resurrect this thread as I'm having the same problem myself now, I can't for the life of me know why they didn't implement more geometry classes in vba, particularly the matrix. Oh well...
I take it from the function above that if there is no ucs name i.e. it is "" that we will get a null object id error so we have to save the current ucs to the ucs table and grab it from there to transform an object to current ucs, is this right??
Also, do you have the SetOrthoUCS function handy?
thanks,
Mick.

Agreed Mick, C# has so much good math on tap.
Public Function SetOrthoUCS(Optional strUcs As String = "Top") As AcadUCS
Dim dOrigin(2) As Double
Dim dXaxisPnt(2) As Double
Dim dYaxisPnt(2) As Double
'all the ucs' will originate from 0,0,0 as per the behavior in acad
Select Case strUcs
Case "Top"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Bottom"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Right"
dXaxisPnt(0) = 0: dXaxisPnt(1) = 1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Left"
dXaxisPnt(0) = 0: dXaxisPnt(1) = 1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Front"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Back"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case Else
Exit Function
End Select
Set SetOrthoUCS = ThisDrawing.UserCoordinateSystems.Add(dOrigin, dXaxisPnt, dYaxisPnt, strUcs)
ThisDrawing.ActiveUCS = SetOrthoUCS
End Function

Thanks Bryco, I'll give those a run and see how it goes.

As far as matrices. You are ok for the ucs as the getvars are updated
Function UcsM() As Variant
Dim M(3, 3) As Double
Dim Orig As Variant
Orig = ThisDrawing.GetVariable("Ucsorg")
Dim x, Y, Z
x = ThisDrawing.GetVariable("UCSXDIR")
Y = ThisDrawing.GetVariable("UCSYDIR")
Z = Crossproduct(x, Y)
M(0, 0) = x(0): M(0, 1) = Y(0): M(0, 2) = Z(0): M(0, 3) = Orig(0)
M(1, 0) = x(1): M(1, 1) = Y(1): M(1, 2) = Z(1): M(1, 3) = Orig(1)
M(2, 0) = x(2): M(2, 1) = Y(2): M(2, 2) = Z(2): M(2, 3) = Orig(2)
M(3, 0) = 0: M(3, 1) = 0: M(3, 2) = 0: M(3, 3) = 1
UcsM = M
End Function
'Vectors
Function XYZ(x As Double, Y As Double, Z As Double) As Variant
Dim P(2) As Double
P(0) = x: P(1) = Y: P(2) = Z
XYZ = P
End Function
Function AddVectors(v1, v2) As Variant
Dim V3(2) As Double
V3(0) = v1(0) + v2(0)
V3(1) = v1(1) + v2(1)
V3(2) = v1(2) + v2(2)
AddVectors = V3
End Function
Function SubtractVectors(v1, v2) As Variant
Dim V3(2) As Double
V3(0) = v1(0)  v2(0)
V3(1) = v1(1)  v2(1)
V3(2) = v1(2)  v2(2)
SubtractVectors = V3
End Function
Function DotProduct(v1, v2)
Dim V3(2) As Double
V3(0) = v1(0) * v2(0)
V3(1) = v1(1) * v2(1)
V3(2) = v1(2) * v2(2)
DotProduct = V3
End Function
Function Crossproduct(A, b) As Variant
Dim Ax As Double, Ay As Double, Az As Double
Dim Bx As Double, By As Double, Bz As Double
Dim Unit As Double
Dim c(2) As Double
'get CrossProduct
Ax = A(0): Ay = A(1): Az = A(2)
Bx = b(0): By = b(1): Bz = b(2)
c(0) = Ay * Bz  Az * By
c(1) = Az * Bx  Ax * Bz
c(2) = Ax * By  Ay * Bx
'Convert to unit normal
Unit = Sqr(c(0) * c(0) + c(1) * c(1) + c(2) * c(2))
c(0) = c(0) / Unit: c(1) = c(1) / Unit: c(2) = c(2) / Unit
Crossproduct = c
End Function
Function NormaliseVector(V As Variant) As Variant
Dim Unit As Double
Dim Vn(2) As Double
Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
NormaliseVector = Vn
End Function
Mick there's some matrix stuff in the text file.
The inverse matrix will be handy as it is a bear to write

Nice code there Bryco! will come in handy for sure.
thanks again.

No wuckers Mick, I still owe you I reckon.

I don't know about that, what I do know though is the UCS is a pig to work with in vba though!
All I'm trying to do is save the current ucs, set the ucs to world, do my mojo then set it back. How I have it 'should' work though I still get strange results if a user picked ucs's vector lines up with a std ucs...strange
Dim ucs As AcadUCS
Set ucs = GetActiveUcs
SetOrthoUCS
ent.TransformBy (ThisDrawing.ActiveUCS.GetUCSMatrix)
ThisDrawing.ActiveUCS = ucs
The SetOrthoUcs sets the ucs to 'top' by default so it should be going to 'world' and it also looks after any conditions where it is set to world.
It's no real biggie and I can live with it, just annoying.

Mick, I am wondering if you are trying to transform an ent by an identity matrix, perhaps you want to use the inverse matrix

It's a bit more difficult than that and what SEANT warned about is the culprit I'm sure.
I'm saving whatever ucs that's current, setting it to world and creating a 3d solid. This gives me a section in wcs ready to transform to wherever I need. I then set it (the ucs) back to where it was and then move the object into position, in this case I create a matrix from a line and it's normal then transform the 3d solid to the line. I'll sort that axis/normal conflict out and see how it goes.
thanks.

Mick, is this true> a circle's normal always works, a line's normal sometimes

I'd say so, only because a circle (or a polygon for that matter) is planar and it has a proper normal, a line is not and afaik the lines normal is only usefull in determining what ucs it was drawn in  ie. its ucs z vector.
This doesn't mean the line's 'normal' will be perp to the line (as you might expect) which is a bit of a pita but that's what I need to check for and work around. For example, say you're in world and the user draws a line form 0,0,0 to 0,0,10 , the line's normal would be 0,0,1 but so is the ucs and the direction of the line.

So using the vector of the line is good instead of the lame line normal

This may be what you want, feed it the line vector and it will give you the x and y axis
Function GetOcsFromNormal(N As Variant) As Variant
'N is the normal vector.
'Wy is the world Y axis, which is always (0,1,0).
'Wz is the world Z axis, which is always (0,0,1).
Dim Wy(2) As Double
Dim Wz(2) As Double
Dim Nx As Double, Ny As Double
Dim Ax, Ay, ocs(1) As Variant
N = NormaliseVector(N)
Wy(0) = 0: Wy(1) = 1: Wy(2) = 0
Wz(0) = 0: Wz(1) = 0: Wz(2) = 1
Nx = N(0): Ny = N(1)
If (Abs(Nx) < 1 / 64) And (Abs(Ny) < 1 / 64) Then
'Ax = Wy X N (where “X” is the crossproduct operator).
Ax = Crossproduct(Wy, N)
Else
Ax = Crossproduct(Wz, N)
End If
ocs(0) = Ax
Ay = Crossproduct(N, Ax)
ocs(1) = Ay
GetOcsFromNormal = ocs
End Function

Yep, then you need to create the other axes from somewhere else, either use the current ucs x & y or the line normal and cross them all to make the matrix orthogonal depending on what you want. I usually use the line and it's normal to create the first 2 axes then cross them for the third making sure to normalise them on the way.
[edit] I already wrote the above before seeing your last post so I'll leave it.
The only reason I use the line normal is so I get the rotation of the 3d section somewhat how I want it, what you have there is what I mention above, I'll give that a go as it may suffice for what I need.
thanks.

I’m interested in the direction of this (and http://www.theswamp.org/index.php?topic=20389.0) thread.
I’d assume that this stage, the orientation of the profile (Roll axis of solid), is the most subject to complication. Not an issue with circles (reference to this thread's title), obviously, but certainly for profiles of considerably fewer axes of symmetry.
Is runtime user interaction the game plan? If not that: Would the best, perhaps only, way to automate an angle iron construction, for example, be with a data imbued wireframe? If that were true, it would certainly increase the scope of the project.
. . .for the life of me know why they didn't implement more geometry classes in vba, particularly the matrix. Oh well...
An ill advised marketing scheme, I believe. Just about all the geometry classes one could ever hope for are available to VBA with Mechanical and MDT via the GeAUTO and BrepAUTO dlls.

Mick, I added
[font=Verdana]Dim ucs As AcadUCS
Set ucs = GetActiveUcs
SetOrthoUCS[/font]
ptInsert(0) = 0: ptInsert(1) = 0: ptInsert(2) = 0
If IsEmpty(ptInsert) Or Err.Number <> 0 Then Exit Sub
If ThisDrawing.Blocks.Item(DWGName) Is Nothing Then
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
DWGPath & "\" & DWGName & ".dwg", 1#, 1#, 1#, 0#)
Else
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
DWGName, 1#, 1#, 1#, 0#)
End If
objBlockExplode = objBlockRef.Explode
objBlockRef.Delete
For lCounter = LBound(objBlockExplode) To UBound(objBlockExplode)
If objBlockExplode(lCounter).ObjectName = "AcDbPolyline" Then
Set objRegEnt(0) = objBlockExplode(lCounter)
objRegion = ThisDrawing.ModelSpace.AddRegion(objRegEnt)
Exit For
End If
Next lCounter
Set objBeam = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), height, 0)
objRegion(0).Delete
objRegEnt(0).Delete
[font=Verdana] objBeam.TransformBy (ThisDrawing.ActiveUCS.GetUCSMatrix)
ThisDrawing.ActiveUCS = ucs[/font]
and it always seemed to work, can you post a dwg where it doesn't?

Hi Bryco, that will work as long as I only want to rotate it to the current ucs, my problem is rotating it to a user picked line (as Sean mentioned). I think the problem is the ucs/line/normal thing and I'll work on it today.
Hi Sean, yes, as you say I would like to use some wire frame geometry as a base for adding sections to. If these were drawn correctly (in the correct ucs to give the correct orientation on insert) the sections come out as expected. With this project it's not so important as I can ask the user for an optional rotate after insertion before ending the command say.
I have already done this in C# some time ago and it was a lot easier given the geometry classes available, that was a pretty complicated project and I want to steer away from that for the moment and make it as simple as possible.
Just simple tools that can later be used to automate easily/quickly as required for your circumstances or discipline. Automation of tasks can come as required once the tools are in place but what I don't want is an 'application' per se that ends up requiring a lot of time to learn it's 'tricks', it can be used just as tools or you can create/use specialised 'routines' that don't required any special requirements prior to use if that makes sense.
If anyones interested I'll start another thread and add the module as an OS project, I have to warn you though it's pretty rough, but it works most of the time :)

I couldn't break it on a user picked line. (which is different than a user picking 2 points)

I couldn't break it on a user picked line. (which is different than a user picking 2 points)
I haven't had a chance to try it yet and probably won't get a chance today, here's some linework I've been using. Try setting the ucs to different ortho's or on the objects etc.

That worked a treat Bryco! I haven't had time to study what's happening yet, I just copied and pasted it in to test and it works well, time to put it to test in the production environment.
thanks!

Bryco  clever use of the AA algorithm. That certainly reduces the guesswork from the profiles final orientation. With an additional objRegion.Rotate  given Nx < 1/64 and Ny < 1/64  the profile could be constrained to a very predictable orientation. Compare the Red and Blue lines in the attached file as demo.
Mick – Is the order of operation which you employ important to your workflow? By that I mean: Could you orient the profile before generating the solid extrusion? This may allow the possibility of solids other than straight lines via AddExtrudedSolidAlongPath. Arcs would certainly be cool and Polys would offer automatic mitering.

Thanks Sean but I virtually copied it from Arbitrary Axis Algorithm found in the dxf reference help.
It has a great explanation in there as well.
I use that more than a ucs as I'm used to it, and it's better for plines.
The use of it did'nt always give me the xaxis I wanted on solids though so there is still a little mystery there.
I'm not quite sure what the drawing is explaining, I see the blue is just out of range.
I guess it's pretty important for Mick's kind of extruding, but I'm not quite sure what you would do with the info

Mick – Is the order of operation which you employ important to your workflow? By that I mean: Could you orient the profile before generating the solid extrusion? This may allow the possibility of solids other than straight lines via AddExtrudedSolidAlongPath. Arcs would certainly be cool and Polys would offer automatic mitering.
Good point Sean, no it wouldn't matter and that would indeed make it easier for extrusions along paths. While that isn't a priority I will definitely look into it, like you say it's only the order of the transformations before the extrusion
cheers.

I'm not quite sure what the drawing is explaining, I see the blue is just out of range.
I guess it's pretty important for Mick's kind of extruding, but I'm not quite sure what you would do with the info
The drawing was just a setup to use with the code the two of you have posted. Basically as a demo to show how the AAA produces a twist beyond the 1/64th boundary.
I assume Autodesk uses that algorithm to ensure sufficient vector separation; lest the cross product fall victim to the quirks of binary math. The unfortunate side effect is that twist in the ocs.
Be that as it may, it is good to have some level of predictability in the profiles final orientation. The general result I’m finding is that any unitized vector within the 1/64th will reproduce the orientation of the reference file. Any extrusion vector outside that polar wobble has the reference files Y direction pointing in an EndpointXY > StartpointXY direction.

It seems that a block inserted on the ocs will always have a rotation of zero.
If you align the block to the line you will find the block has a rotation and that is the rotation that the ocs x axis has from the world axis
The following makes the use of the ocs consistant with the align command
Option Explicit
Const pi As Double = 3.14159265358979
Public Sub draw2()
Dim Line As AcadLine, basePnt As Variant
ThisDrawing.Utility.GetEntity Line, basePnt, "Select a line only:"
Dim mat
Dim Rot As Double
Dim vx(2) As Double, vy(2) As Double, vz(2) As Double
'get the lines epsp vector to create the z axis:
vz(0) = Line.EndPoint(0)  Line.StartPoint(0)
vz(1) = Line.EndPoint(1)  Line.StartPoint(1)
vz(2) = Line.EndPoint(2)  Line.StartPoint(2)
'normalise it:
VecNorm vz
mat = MatrixFromNormal(vz, Line.StartPoint, Rot)
Dim objRegEnt(0) As AcadEntity, objRegion As Variant
Dim objBlockRef As AcadBlockReference, objBlockExplode As Variant
Dim objBeam As Acad3DSolid
Dim ptInsert(2) As Double
Dim lCounter As Integer
Dim UCS As AcadUCS
Set UCS = GetActiveUcs
SetOrthoUCS
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
"310UB040", 1#, 1#, 1#, Rot)
objBlockExplode = objBlockRef.Explode
objBlockRef.Delete
For lCounter = LBound(objBlockExplode) To UBound(objBlockExplode)
If objBlockExplode(lCounter).ObjectName = "AcDbPolyline" Then
Set objRegEnt(0) = objBlockExplode(lCounter)
objRegion = ThisDrawing.ModelSpace.AddRegion(objRegEnt)
Exit For
End If
Next lCounter
Set objBeam = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), Line.Length, 0)
objRegion(0).Delete
objRegEnt(0).Delete
objBeam.TransformBy (mat)
ThisDrawing.ActiveUCS = UCS
End Sub
Public Function VecNorm(ByRef vec() As Double)
'Normalises the incoming vector.
Dim unit As Double
unit = Sqr(vec(0) * vec(0) + vec(1) * vec(1) + vec(2) * vec(2))
vec(0) = vec(0) / unit: vec(1) = vec(1) / unit: vec(2) = vec(2) / unit
End Function
Function NormaliseVector(V As Variant) As Variant
Dim unit As Double
Dim Vn(2) As Double
unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
Vn(0) = V(0) / unit: Vn(1) = V(1) / unit: Vn(2) = V(2) / unit
NormaliseVector = Vn
End Function
Function MatrixFromNormal(N As Variant, orig As Variant, Rot As Double) As Variant
Dim m(3, 3) As Double
Dim Z
Dim Wy(2) As Double, Wz(2) As Double
Dim Nx As Double, Ny As Double
Dim Ax, Ay As Variant
N = NormaliseVector(N)
Wy(0) = 0: Wy(1) = 1: Wy(2) = 0
Wz(0) = 0: Wz(1) = 0: Wz(2) = 1
Nx = N(0): Ny = N(1)
If (Abs(Nx) < 1 / 64) And (Abs(Ny) < 1 / 64) Then
'Ax = Wy X N (where “X” is the crossproduct operator).
Ax = Crossproduct(Wy, N)
Else
Ax = Crossproduct(Wz, N)
End If
Ay = Crossproduct(N, Ax)
'Z = Crossproduct(Ax, Ay)
Z = N
m(0, 0) = Ax(0): m(0, 1) = Ay(0): m(0, 2) = Z(0): m(0, 3) = orig(0)
m(1, 0) = Ax(1): m(1, 1) = Ay(1): m(1, 2) = Z(1): m(1, 3) = orig(1)
m(2, 0) = Ax(2): m(2, 1) = Ay(2): m(2, 2) = Z(2): m(2, 3) = orig(2)
m(3, 0) = 0: m(3, 1) = 0: m(3, 2) = 0: m(3, 3) = 1
MatrixFromNormal = m
Dim Wx(2) As Double
Wx(0) = 1
Dim P
P = TransformPt2(m, Wx)
Rot = AngFromX(orig, P)
End Function
Function TransformPt2(m As Variant, P1 As Variant) As Variant
Dim i As Integer
Dim X As Double, Y As Double, Z As Double, d As Double
Dim P(3) As Double
Dim P2(2) As Double
For i = 0 To 2
P(i) = P1(i)
Next
P(3) = 1
For i = 0 To 3
X = X + P(i) * m(0, i)
Y = Y + P(i) * m(1, i)
Z = Z + P(i) * m(2, i)
d = d + P(i) * m(3, i)
Next
P2(0) = X: P2(1) = Y: P2(2) = Z
TransformPt2 = P2
End Function
Function Crossproduct(a, B) As Variant
Dim Ax As Double, Ay As Double, Az As Double
Dim Bx As Double, By As Double, Bz As Double
Dim unit As Double
Dim C(2) As Double
'get CrossProduct
Ax = a(0): Ay = a(1): Az = a(2)
Bx = B(0): By = B(1): Bz = B(2)
C(0) = Ay * Bz  Az * By
C(1) = Az * Bx  Ax * Bz
C(2) = Ax * By  Ay * Bx
'Convert to unit normal
unit = Sqr(C(0) * C(0) + C(1) * C(1) + C(2) * C(2))
C(0) = C(0) / unit: C(1) = C(1) / unit: C(2) = C(2) / unit
Crossproduct = C
End Function
Public Function AngFromX(P1, P2) As Double
'If Not PointCheck(p1, p2) Then Exit Function
Dim Dx As Double, dY As Double
Dim dAng As Double
dY = P2(1)  P1(1): Dx = P2(0)  P1(0)
If Rd(dY, 0) Then 'Line is horizontal
If Rd(Dx, 0) Then Exit Function
If Dx > 0 Then
dAng = 0
Else
dAng = pi '180
End If
ElseIf Rd(Dx, 0) Then 'Line is vertical
If dY > 0 Then
dAng = 0.5 * pi '90
Else
dAng = 1.5 * pi '270
End If
Else
dAng = Atn(dY / Dx)
If dAng < 0 Then '90>270
If Dx < 0 Then '90>270
dAng = pi + dAng '90>180
Else '270>360
dAng = 2 * pi + dAng
End If
Else
If Dx < 0 And dY < 0 Then '180>270
dAng = pi + dAng
End If
End If
End If
AngFromX = dAng
End Function
Function Rd(num1 As Variant, num2 As Variant) As Boolean
Dim dRet As Double
dRet = num1  num2
If Abs(dRet) < 0.00000001 Then Rd = True
End Function
Function GetActiveUcs() As AcadUCS
Dim Origin
Dim Xaxis
Dim Yaxis
Dim strNm As String, sUcs As String
Dim Zero(2) As Double
sUcs = ThisDrawing.GetVariable("UCSNAME")
If sUcs = "" Then
' Current UCS is not saved so get the data and save it
'A ucs is saved when a user makes and saves one or
' a user clicks on an isoview button
With ThisDrawing
If .GetVariable("WORLDUCS") = 1 Then
Xaxis = Zero: Yaxis = Zero
Xaxis(0) = 1: Yaxis(1) = 1
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "World")
Exit Function
End If
Origin = .GetVariable("UCSORG")
Xaxis = .GetVariable("UCSXDIR")
Yaxis = .GetVariable("UCSYDIR")
strNm = "Active"
End With
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, strNm)
'Changing the origin later stops the error message
'2145320930 UCS X axis and Y axis are not perpendicular
GetActiveUcs.Origin = Origin
ThisDrawing.ActiveUCS = GetActiveUcs
Else
Select Case sUcs
Case "*TOP*", "TOP"
Set GetActiveUcs = SetOrthoUCS("Top")
Case "*BOTTOM*"
Set GetActiveUcs = SetOrthoUCS("Bottom")
Case "*LEFT*"
Set GetActiveUcs = SetOrthoUCS("Left")
Case "*RIGHT*"
Set GetActiveUcs = SetOrthoUCS("Right")
Case "*FRONT*"
Set GetActiveUcs = SetOrthoUCS("Front")
Case "*BACK*"
Set GetActiveUcs = SetOrthoUCS("Back")
Case Else
Set GetActiveUcs = ThisDrawing.ActiveUCS 'current UCS is saved
End Select
End If
End Function
Public Function SetOrthoUCS(Optional strUcs As String = "Top") As AcadUCS
Dim dOrigin(2) As Double
Dim dXaxisPnt(2) As Double
Dim dYaxisPnt(2) As Double
'all the ucs' will originate from 0,0,0 as per the behavior in acad
Select Case strUcs
Case "Top"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Bottom"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Right"
dXaxisPnt(0) = 0: dXaxisPnt(1) = 1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Left"
dXaxisPnt(0) = 0: dXaxisPnt(1) = 1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Front"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Back"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
End Select
Set SetOrthoUCS = ThisDrawing.UserCoordinateSystems.Add(dOrigin, dXaxisPnt, dYaxisPnt, strUcs)
ThisDrawing.ActiveUCS = SetOrthoUCS
End Function

The following makes the use of the ocs consistant with the align command
That is a comforting level of consistancy. Nicely done.

Thanks Sean
Time for a yabbadabbado