Author Topic: Circle Norm  (Read 10959 times)

0 Members and 1 Guest are viewing this topic.

MickD

  • King Gator
  • Posts: 3619
  • (x-in)->[process]->(y-out) ... simples!
Re: Circle Norm
« Reply #30 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.
"Short cuts make long delays,' argued Pippin.”
J.R.R. Tolkien

SEANT

  • Bull Frog
  • Posts: 345
Re: Circle Norm
« Reply #31 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.
« Last Edit: January 05, 2008, 10:24:58 AM by SEANT »
Sean Tessier
AutoCAD 2016 Mechanical

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Circle Norm
« Reply #32 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

SEANT

  • Bull Frog
  • Posts: 345
Re: Circle Norm
« Reply #33 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.
Sean Tessier
AutoCAD 2016 Mechanical

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Circle Norm
« Reply #34 on: January 11, 2008, 08:00:24 AM »
Thanks Sean 
Time for a yabbadabbado