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