epicyclic curve

Some cool responses here guys - this is what the NG is all about - Onyaz!

Hey Giorgis; you wouldn't happen to be making a gear would you? How about
take a lok at geartrax - it aint much to buy, and has a whole truckload of
functionality...

I think it is from a Co called camtrax???

google it

 

I am not quite making a gear. I have an Octagon about 240mm accross
sides. I have a roller that runs on the flat of the octagon as it
turns. I want the octagon to drive the roller by friction. I want to
place "teeth" on the corners of the octagon to bring the roller back in
synch if it goes out.

Thanks for all the advice guys. Sorry for starting out vague, it was
not intentional. I reaslied as the thread advanced that I need to
provide more info.

I have tried a few things now, I should start making them soon.

Thanks again
Giorgis

 

Here is version 1.0 which of course comes after 0.0

'******************************************************************************
' macro recorded on 05/24/05 by kellnerp
'
' REV BY DATE COMMENTS
' 1.0 PBK 5/30/05 CORRECTED PROBLEM AT VERTEX, ADDED INPUT BOXES
'
'******************************************************************************
Option Explicit
Const pi As Double = 3.141592654
Const iPts As Long = 10

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim skPts() As Double

Sub Epicycloid(ByVal N As Long, ByVal A As Double, ByVal b As Double)

ReDim skPts(N + 1, 3) As Double
Dim i As Long
Dim x, y, z As Double
Dim phi, dphi As Double

dphi = 2 * pi / N

For i = 0 To N - 1

x = (A + b) * Cos(i * dphi) - b * Cos((A + b) / b * i * dphi)
y = (A + b) * Sin(i * dphi) - b * Sin((A + b) / b * i * dphi)
z = 0#

skPts(i, 0) = x
skPts(i, 1) = y
skPts(i, 2) = z
Next i

x = (A + b) * Cos(0 * dphi) - b * Cos((A + b) / b * 0 * dphi)
y = (A + b) * Sin(0 * dphi) - b * Sin((A + b) / b * 0 * dphi)
z = 0#

skPts(N, 0) = x
skPts(N, 1) = y
skPts(N, 2) = z

End Sub


Private Function Get_A() As Double

Dim Message, Title, Default As String
Dim A As Double

' Set prompt.
Message = "Enter Base Circle Diameter: "
Title = "SET A" ' Set title.
Default = "1.000" ' Set default.

' Display message, title, and default value.
A = Val(InputBox(Message, Title, Default, 200, 200))
Get_A = A

End Function

Private Function Get_m() As Long

Dim Message, Title, Default As String
Dim m As Long

' Set prompt.
Message = "Enter the number of petals (Integer >=1) "
Title = "SET m" ' Set title.
Default = "1" ' Set default.

' Display message, title, and default value.
m = Val(InputBox(Message, Title, Default, 200, 200))

If m < 1 Then m = 1

Get_m = m

End Function
Sub main()

Dim A As Double
Dim b, m, N As Long
Dim i, j As Long

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID("Front", "PLANE", 0, 0, 0,
False, 0, Nothing)

' a is the OD of the circle around which you want the epicycloid. m is
the number of cusps.
A = Get_A()
m = Get_m()

'Don't change anything below here.

b = A / m
N = iPts * m

Call Epicycloid(N, A, b)

For j = 1 To m

'Start the sketch
If j = 1 Then

Part.InsertSketch2 True
Part.ClearSelection2 True

End If

'For i = N To 0 Step -1
For i = iPts * j To iPts * (j - 1) Step -1

Part.SketchSpline i - iPts * (j - 1), skPts(i, 0), skPts(i,
1), skPts(i, 2): Debug.Assert True

Next i

Next j

'End the Sketch

Part.ClearSelection2 True
Part.InsertSketch2 True

Part.EditRebuild3
Part.ViewZoomtofit2

End Sub

 

This isn't really an epicyclic curve that a point on the roller is
following. I would assume that the roller circumference is equal to
the width of a facet on the octagon. Then the roller would make exactly
one revolutions across the width of the flat. As the roller approaches
the corner a point on the roller would describe a cycloid WRT the flat.

 

I didn't say it before when I should have:

Nice job.

 

The circumferance of the roller is three times that of a side on the
octagon. In fact it is slightly longer as I want it always to err on
one side so that the correction needs to be one sided.

Giorgis

PS: Great job, I will try this when I get back to work tomorrow