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