OIDS

CYCLOID

Here is a quicky macro to create any number of cycloids along the X
axis of a sketch.

'******************************************************************************
' macro recorded on 05/29/05 by kellnerp
'
' REV BY DATE COMMENTS
' 0.0 PBK 5/29/05 MODIFIED EPICYCLOID TO MAKE CYCLOID
'
' ASSUMES A PART IS OPEN AND THE FIRST PLANE IS NAMED "Front"
' TO OBTAIN A CYLCLOIT ON A PLANE OTHER THAN "Front" CHANGE
' THE CONST BELOW TO THE NAME IN THE MODEL. CYCLOID WILL BE
' DRAWN ALONG THE "X" AXIS.
'******************************************************************************
Option Explicit
Const pi As Double = 3.141592654
Const iPts As Long = 10
Const Plane As String = "Front"

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 Cycloid(ByVal N As Long, ByVal A As Double, ByVal m 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 / iPts

For i = 0 To N - 1

x = A * (i * dphi - Sin(i * dphi))
y = A * (1 - Cos(i * dphi))
z = 0#

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

x = A * (i * dphi - Sin(i * dphi))
y = A * (1 - Cos(i * 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(Plane, "PLANE", 0, 0, 0, False,
0, Nothing)

' A is the OD of the circle generating the Cycloid. m is the number of
cusps.
A = Get_A()
' m is the number of cusps
m = Get_m()

'Don't change anything below here.


N = iPts * m

Call Cycloid(N, A, m)

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

 

EPICYCLOID

Here is a quicky macro to create an epicycloid with any number of
petals about a circle centered on the sketch origin with the first
vertex located on the positive X axis.

'******************************************************************************
' 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