• Industries
  • Products
  • Buy
  • Services & Support
  • Communities
  • Discussion Groups

    .NET

    Reply
    Distinguished Contributor
    Posts: 311
    Registered: ‎07-29-2004

    Code4Fun - Sierpinski curves

    67 Views, 0 Replies
    10-24-2005 02:47 PM
    Just a quickie I whipped out to test performance of the api. I was impressed as the speed is very good.

    Caveat: I did this in integer math to maximize the test of the Autocad API , so the number of levels is limited to 7.

    I was unable to get the graphics to flush out as the routine executes. I figured out the app Transaction verus database Transaction grief, did queue for flush and even tried AcDbLine::draw with no success.

    If anyone has any ideas how to get this to draw as it goes, please let me know. Not a biggie, but it appears to be a bug in the API.

    ******** Start Class AcGraphics

    Public Class AcGraphics
    _
    Public Shared Function acedGrDraw(ByVal fromPoint As Double(), ByVal toPoint As Double(), ByVal color As Integer, ByVal hl As Integer) As Integer
    End Function
    End Class

    ******** Start class Turtle

    Imports Autodesk.AutoCAD.Runtime
    Imports Autodesk.AutoCAD.ApplicationServices
    Imports Autodesk.AutoCAD.EditorInput
    Imports Autodesk.AutoCAD.Geometry
    Imports Autodesk.AutoCAD.DatabaseServices
    Imports DbTransactionManager = Autodesk.AutoCAD.DatabaseServices.TransactionManager


    Public Class Turtle
    Private m_db As Database
    Private m_bt As BlockTable
    Private m_btr As BlockTableRecord
    Private m_tm As DbTransactionManager
    Private m_create As Boolean
    Private m_pen(2) As Double
    Private m_direction As Double = 0
    Private m_lineCount As Integer

    Public Sub New(ByVal createLines As Boolean, ByVal db As Database)
    m_db = db
    m_create = createLines
    m_tm = db.TransactionManager

    m_bt = m_tm.GetObject(db.BlockTableId, OpenMode.ForRead, False)
    m_btr = m_tm.GetObject(m_bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False)
    End Sub

    Public ReadOnly Property LineCount() As Integer
    Get
    Return m_lineCount
    End Get
    End Property

    Public Sub MoveTo(ByVal x As Double, ByVal y As Double, ByVal z As Double)
    m_pen(0) = x
    m_pen(1) = y
    m_pen(2) = z
    End Sub

    ' done as degrees to match most turtle code
    Public Sub Rotate(ByVal angleDegrees As Double)
    m_direction += angleDegrees * Math.PI / 180.0

    If m_direction > 2 * Math.PI Then m_direction -= 2 * Math.PI
    If m_direction < 0.0 Then m_direction += 2 * Math.PI
    End Sub

    ' draws a line using the pen position and the current direction, updates pen
    Public Sub Forward(ByVal dist As Double, ByVal color As Integer)
    ' from point will be current pen
    Dim toPt(2) As Double
    Dim dx As Double = dist * Math.Cos(m_direction)
    Dim dy As Double = dist * Math.Sin(m_direction)
    toPt(0) = m_pen(0) + dx
    toPt(1) = m_pen(1) + dy
    toPt(2) = m_pen(2)
    DrawTo(toPt(0), toPt(1), toPt(2), color)
    End Sub

    ' draws to a location and sets the turtle to that point
    Public Sub DrawTo(ByVal x As Double, ByVal y As Double, ByVal z As Double, Optional ByVal color As Integer = 0)
    ' from point will be current pen
    Dim toPt(2) As Double
    toPt(0) = x
    toPt(1) = y
    toPt(2) = z
    If m_create Then
    Dim dbLine As New Line(New Point3d(m_pen), New Point3d(toPt))
    dbLine.ColorIndex = color
    Dim id As ObjectId
    id = m_btr.AppendEntity(dbLine)
    m_tm.AddNewlyCreatedDBObject(dbLine, True)
    Else
    AcGraphics.acedGrDraw(m_pen, toPt, color, 0)
    End If
    m_pen = toPt
    m_lineCount += 1
    End Sub
    End Class

    *** Start Seirpinski Command class
    Imports System

    Imports Autodesk.AutoCAD.ApplicationServices
    Imports Autodesk.AutoCAD.EditorInput
    Imports Autodesk.AutoCAD.DatabaseServices

    Public Class Sierpinksi
    Dim m_turtle As Turtle
    Dim m_color As Integer
    Dim m_create As Boolean
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim h As Integer

    _
    Public Sub Sierpinski()
    Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor
    Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
    Dim trans As Transaction

    Try
    Dim nCurves As Integer = 0
    m_create = False

    Dim prInt As PromptIntegerResult
    prInt = editor.GetInteger("Enter curve recursion depth")
    If prInt.Status <> PromptStatus.OK Then Return
    If prInt.Value > 7 Then
    editor.WriteMessage("Integer math limit reached, talk to the hand")
    Return
    End If

    Dim prStr As PromptResult
    prStr = editor.GetKeywords("Draw or Create?", New String() {"Draw", "Create"})
    If prStr.Status <> PromptStatus.OK Then Return

    If prStr.StringResult = "Create" Then m_create = True

    trans = db.TransactionManager.StartTransaction
    m_turtle = New Turtle(m_create, db)

    Serp(prInt.Value)

    editor.WriteMessage("Generated " & m_turtle.LineCount() & " lines")

    trans.Commit()
    Catch ex As Exception
    trans.Abort()
    MsgBox(ex.Message)
    Finally
    trans.Dispose()
    End Try

    End Sub

    ' generate Sierpinski curves, credit goes to Niklaus Wirth for the method
    Private Sub Serp(ByVal nCurves As Integer)
    Dim size As Integer = 512
    Dim i As Integer = 0
    h = size / 4
    Dim x0 As Integer = 2 * h
    Dim y0 As Integer = 3 * h
    z = 0
    For i = 1 To nCurves
    x0 -= h
    h /= 2
    y0 += h
    x = x0
    y = y0
    m_color = i
    m_turtle.MoveTo(x0, y0, z)
    A(i) : x += h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    B(i) : x -= h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    C(i) : x -= h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    D(i) : x += h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    z -= 128
    Next
    End Sub

    Private Sub A(ByVal i As Integer)
    If i = 0 Then Return
    A(i - 1) : x += h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    B(i - 1) : x += 2 * h : m_turtle.DrawTo(x, y, z, m_color)
    D(i - 1) : x += h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    A(i - 1)
    End Sub

    Private Sub B(ByVal i As Integer)
    If i = 0 Then Return
    B(i - 1) : x -= h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    C(i - 1) : y -= 2 * h : m_turtle.DrawTo(x, y, z, m_color)
    A(i - 1) : x += h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    B(i - 1)
    End Sub

    Private Sub C(ByVal i As Integer)
    If i = 0 Then Return
    C(i - 1) : x -= h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    D(i - 1) : x -= 2 * h : m_turtle.DrawTo(x, y, z, m_color)
    B(i - 1) : x -= h : y -= h : m_turtle.DrawTo(x, y, z, m_color)
    C(i - 1)
    End Sub

    Private Sub D(ByVal i As Integer)
    If i = 0 Then Return
    D(i - 1) : x += h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    A(i - 1) : y += 2 * h : m_turtle.DrawTo(x, y, z, m_color)
    C(i - 1) : x -= h : y += h : m_turtle.DrawTo(x, y, z, m_color)
    D(i - 1)
    End Sub

    End Class
    Please use plain text.