How Can I draw Spirograph in AutoCAD?

[khoshravan]

Spirograph, as some of you may know is curves obtained by sliding a circle inside or outside another circle with different radius without slipping.

 

There is a toy for drawing these graphs as well. I read in a site, it is possible to draw them on computer as well (http://wordsmith.org/anu/java/spirograph.html) but I couldn't succeed.

 

I want to know is it possible to write a VBA in AutoCad so that I draw them in AUTOCAD?

 

Any comment is highly appreciated.

 

BR

Khoshravan

[kencaz]

You can simulate them quite easily with a polar array.

 

Autocad:

 

 

 

From Website:

 

 

KC

[nestly]

There's a plugin at Autodesk Labs, that's supposed to work with 2007 and newer

 

http://labs.blogs.com/its_alive_in_the_lab/2010/05/adn-plugin-of-the-month-spiro-for-autocad-now-available.html

 

Download page (May 2010) http://labs.autodesk.com/utilities/adn_plugins/supported_apps/

[Jack_O'neill]

Or even just a simple circle arrayed around itself:

[fuccaro]

For a real one you will need some programs but for decorations use the array command as above.

[fuccaro]

I searched for you in the forum: http://www.cadtutor.net/forum/showthread.php?32051-Something-a-Little-Different...

Don't stop reading at the first page.

[khoshravan]

There's a plugin at Autodesk Labs, that's supposed to work with 2007 and newer

 

http://labs.blogs.com/its_alive_in_the_lab/2010/05/adn-plugin-of-the-month-spiro-for-autocad-now-available.html

 

Download page (May 2010) http://labs.autodesk.com/utilities/adn_plugins/supported_apps/

 

Thanks. I will check these pages.

Also thanks for fuccaro.

[SEANT]

Here’s my attempt. It basic; requiring a very specific setup. See the attached file for the general orientations required by the routing. With certain radius ratios this routine would benefit with a bit of recursion, but this was all the time I could invest in it.

Option Explicit
Const TwoPi As Double = 3.14159265359 * 2
Sub CreatePattern()
Dim StationaryCircle As AcadCircle
Dim RotatingCircle As AcadCircle
Dim PenPoint As AcadPoint
Dim tempPoint As AcadPoint
Dim varPkPt As Variant
Dim rotationAngle As Double
Dim ent As AcadEntity
Dim Origin(2) As Double
Dim PenPt() As Double
Dim SpiroCurve As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 194) As Double
Dim RadRatio As Double
Dim vararray As Variant
Dim varNewarray As Variant
Dim NumOfArray As Integer
Dim NumOfInitialRotations As Integer
Dim Remain As Double
Dim count As Integer
Dim SeqBlock As AcadBlock
Dim ref As AcadBlockReference
  On Error Resume Next
  With ThisDrawing.Utility
     .GetEntity ent, varPkPt, "Select Circle at WCS origin: "
     If Err <> 0 Then Exit Sub
     If TypeOf ent Is AcadCircle Then
        Set StationaryCircle = ent
     Else: Exit Sub
     End If
        If Round(DistBetween2PtST(Origin, StationaryCircle.center), 6) <> 0 Then Exit Sub
        
     .GetEntity ent, varPkPt, "Select Circle that rotates: "
     If Err <> 0 Then Exit Sub
     If TypeOf ent Is AcadCircle Then
        Set RotatingCircle = ent
     Else: Exit Sub
     End If
     
     If (StationaryCircle.radius + RotatingCircle.radius) - RotatingCircle.center(0) > 0.0000001 Then
     .Prompt "Circles are not situated correctly! Operation Cancelled. "
     Exit Sub
     End If
     
     RadRatio = StationaryCircle.radius / RotatingCircle.radius
     NumOfInitialRotations = Round(RadRatio)
     Remain = RadRatio - NumOfInitialRotations
     If Abs(Remain) < 0.0000001 Then
        NumOfArray = 0
        Remain = 0
     End If
         
     .GetEntity ent, varPkPt, "Select Pen Point in rotating circle: "
     If Err <> 0 Then Exit Sub
     On Error GoTo 0
     If TypeOf ent Is AcadPoint Then
        Set PenPoint = ent
        PenPt = PenPoint.Coordinates
     Else: Exit Sub
     End If
     Dim i As Integer
     
     fitPoints(0) = PenPt(0)
     fitPoints(1) = PenPt(1)
     fitPoints(2) = PenPt(2)
     
     For i = 1 To 64
        Set tempPoint = PenPoint.Copy
        tempPoint.Rotate RotatingCircle.center, (TwoPi / 64) * i
        tempPoint.Rotate StationaryCircle.center, (TwoPi / 64) * i * (RotatingCircle.radius / StationaryCircle.radius)
        varPkPt = tempPoint.Coordinates
        
        fitPoints(i * 3) = varPkPt(0)
        fitPoints(i * 3 + 1) = varPkPt(1)
        fitPoints(i * 3 + 2) = varPkPt(2)
        tempPoint.Delete
     
     Next
     Set SeqBlock = ThisDrawing.Blocks.Add(Origin, "oneTurn")
     
     Set SpiroCurve = SeqBlock.AddSpline(fitPoints, startTan, endTan)
     rotationAngle = (TwoPi / RadRatio)
     
     For i = 0 To NumOfInitialRotations - 1
        Set ent = SpiroCurve.Copy
        ent.Rotate Origin, rotationAngle * i
     Next
     Set ref = ThisDrawing.ModelSpace.InsertBlock(Origin, "oneTurn", 1, 1, 1, 0)
     If Remain <> 0 Then
        rotationAngle = (rotationAngle * NumOfInitialRotations) - TwoPi
        NumOfArray = Floor(Abs(TwoPi / rotationAngle), 1)
        For i = 0 To NumOfArray - 1
           Set ent = ref.Copy
           ent.Rotate Origin, rotationAngle * i
        Next
     End If
  End With
End Sub
Function DistBetween2PtST(dblPt1 As Variant, dblPt2 As Variant) As Double
DistBetween2PtST = Sqr((dblPt2(0) - dblPt1(0)) ^ 2 + (dblPt2(1) - dblPt1(1)) ^ 2 + (dblPt2(2) - dblPt1(2)) ^ 2)
End Function
Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
Floor = Int(X / Factor) * Factor
End Function

SpiroSetup.dwg

[khoshravan]

Thanks.

I will try it.