TheSwamp

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

Title: Circle Norm
Post 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?
Title: Re: Circle Norm
Post by: MickD on August 02, 2007, 07:27:31 PM
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.
Title: Re: Circle Norm
Post by: Bryco on August 02, 2007, 07:38:09 PM
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?
Title: Re: Circle Norm
Post by: MickD on August 02, 2007, 08:10:33 PM
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
Title: Re: Circle Norm
Post by: Bryco on August 02, 2007, 09:52:23 PM
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.
Title: Re: Circle Norm
Post by: Bryco on August 02, 2007, 10:00:57 PM
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.
Title: Re: Circle Norm
Post by: MickD on August 02, 2007, 10:20:13 PM
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 origin-al 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
Title: Re: Circle Norm
Post by: Bryco on August 03, 2007, 05:03:29 PM
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.


Code: [Select]
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


Code: [Select]
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
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 05:47:44 PM
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.
Title: Re: Circle Norm
Post by: Bryco on January 02, 2008, 07:17:00 PM
Agreed Mick, C# has so much good math on tap.
Code: [Select]
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
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 07:30:10 PM
Thanks Bryco, I'll give those a run and see how it goes.
Title: Re: Circle Norm
Post by: Bryco on January 02, 2008, 07:32:17 PM
As far as matrices. You are ok for the ucs as the getvars are updated
Code: [Select]
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
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 07:42:01 PM
Nice code there Bryco! will come in handy for sure.
thanks again.
Title: Re: Circle Norm
Post by: Bryco on January 02, 2008, 08:00:57 PM
No wuckers Mick,  I still owe you I reckon.
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 09:42:29 PM
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

Code: [Select]
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.
Title: Re: Circle Norm
Post by: Bryco on January 02, 2008, 10:10:18 PM
Mick, I am wondering if you are trying to transform an ent by an identity matrix, perhaps you want to use the inverse matrix
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 10:23:56 PM
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.
Title: Re: Circle Norm
Post by: Bryco on January 02, 2008, 10:40:36 PM
Mick, is this true-> a circle's normal always works, a line's normal sometimes
Title: Re: Circle Norm
Post by: MickD on January 02, 2008, 10:48:59 PM
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.
Title: Re: Circle Norm
Post by: Bryco on January 03, 2008, 12:42:18 AM
So using the vector of the line is good instead of the lame line normal
Title: Re: Circle Norm
Post by: Bryco on January 03, 2008, 12:50:10 AM
This may be what you want, feed it the line vector and it will give you the x and y axis
Code: [Select]
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 cross-product 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
Title: Re: Circle Norm
Post by: MickD on January 03, 2008, 12:54:42 AM
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.
Title: Re: Circle Norm
Post by: SEANT on January 03, 2008, 04:53:15 AM
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.   
Title: Re: Circle Norm
Post by: Bryco on January 03, 2008, 10:08:52 AM
Mick, I added
Code: [Select]
   [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?
Title: Re: Circle Norm
Post by: MickD on January 03, 2008, 04:29:17 PM
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 :)
Title: Re: Circle Norm
Post by: Bryco on January 03, 2008, 05:27:52 PM
I couldn't break it on a user picked line. (which is different than a user picking 2 points)
Title: Re: Circle Norm
Post by: MickD on January 03, 2008, 05:49:48 PM
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.
Title: Re: Circle Norm
Post by: MickD on January 03, 2008, 09:13:32 PM
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!
Title: Re: Circle Norm
Post by: SEANT on January 04, 2008, 06:51:54 PM
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.
Title: Re: Circle Norm
Post by: Bryco on January 04, 2008, 08:05:02 PM
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
Title: Re: Circle Norm
Post by: MickD on January 04, 2008, 10:52:28 PM
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.
Title: Re: Circle Norm
Post by: SEANT on January 05, 2008, 09:11:10 AM
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.
Title: Re: Circle Norm
Post by: Bryco on January 09, 2008, 11:12:00 AM
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

Code: [Select]
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 ep-sp 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 cross-product 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
Title: Re: Circle Norm
Post by: SEANT on January 11, 2008, 04:12:36 AM
The following makes the use of the ocs consistant with the align command

That is a comforting level of consistancy.  Nicely done.
Title: Re: Circle Norm
Post by: Bryco on January 11, 2008, 08:00:24 AM
Thanks Sean 
Time for a yabbadabbado