Creating an Automated, Personalized Frame Generator Using SolidWorks VBA

1 Introduction
2 Macro Breakdown
- 2.1 UserForm
- 2.2 Sketch Creation
- 2.3 Plane Creation
- 2.4 Tube Sketches
- 2.5 Tube Creation
  - 2.5.1 Front Triangle
  - 2.5.2 Rear Triangle
- 2.6 Hiding Sketches
3 Future Plans
4 Macro File

Introduction

Macro Breakdown

UserForm

The macro starts by opening a user form to allow the user to input their height, leg length, arm length and mass. In the first version of the macro, the mass section doesn't affect the overall outcome of the bike but in a future version, the mass will affect the thickness of the bike tubes. For now, the mass is only required as a placeholder in the code. Also on the user form are 8 dropdown menus. In this version, the dropdown menus do not serve any purpose, although in future iterations the drop-down menus were intended to allow the user to select what supplier they would like to purchase each tube from.


UserForm in Bicycle Macro

Sketch Creation

The next step in the macro is the creation of the sketches that make the general outline of the sketch. In total there are 7 sketches (six 2D sketches and one 3D sketch), sketches 1-6 could be condensed into one sketch if to make the tubes an extrusion is used, but if revolves or any other feature that requires a line or curve to guide the extrusion, multiple sketches will need to be made. The sketch creation isn't a necessary step (if using extrusions) in the macro it just provides a skeleton to build from while scripting the macro. The sketch dimensions are determined by a series of trigonometric ratios based on the inputted data and The Bike Frame Design and Manufacturing. Below is a snippet of some of the code used to determine the geometry of the bike sketches.

' Variable Definitons (This section of code was taken from the Measurements section)
    standover = leg_length
    pedal_to_standover = (standover - ((tire / 2) - BB_drop))
    reach = (standover + arm_length) / 3.5
    seat_tube_length = pedal_to_standover / Cos(ST_Invr)
    stack = 0.55
    ST_inner = cos_law(CS_SS_angle, CS_length, SS_length)
    HT_end_length = (HT_length - 0.05) / 2
    HT_2of3_length = HT_end_length + 0.05

' ST (This section of code was take from the Bike_Sketch sub in the Functions Module)
        Part.SketchManager.InsertSketch True
        boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", -6.41840362860552E-02, 4.40197018973685E-02, 3.96270537685864E-03, False, 0, Nothing, 0)
        Part.ClearSelection2 True
        Dim skSegment As Object
        Set skSegment = Part.SketchManager.CreateCenterLine(0#, 0#, 0#, -1 * tan_adj_side(seat_tube_angle, stack), stack, 0#)
        
        Part.SetPickMode
        Part.ClearSelection2 True
        Part.SketchManager.InsertSketch True
        Part.ClearSelection2 True

Plane Creation

The next thing the macro does is create planes for a new set of sketches, these new sketches will be used to make extrusions of the tubes. Using the bike_sketch as a skeleton, the planes were created by selecting a line and making the plane perpendicular to it. Then an endpoint on the line was chosen to orient the position of the plane. Below is an example code showing what happens:

' Selecting the line and the point	
	boolstatus = Part.Extension.SelectByID2("Line1@Sketch1", "EXTSKETCHSEGMENT", -0.152785493176754, 0.499738197778628, 0, True, 0, Nothing, 0)
	boolstatus = Part.Extension.SelectByID2("Point1@Sketch1", "EXTSKETCHPOINT", 0, 0, 0, True, 1, Nothing, 0)
	Dim myRefPlane As Object
' Creating the plane
	Set myRefPlane = Part.FeatureManager.InsertRefPlane(2, 0, 4, 0, 0, 0)
	Part.ClearSelection2 True

Tube Sketches

Using the planes created in the last step the macro then creates circles with the same diameter as each tube. These sketches are used in extrusions and lofts that create the pipes. Below is the public subroutine ST_Circles that creates the circles used in the seat tube:

Public Sub TT_Circles(x As Double)

	Set swApp = Application.SldWorks

	Set Part = swApp.ActiveDoc
	Dim COSMOSWORKSObj As Object
	Dim CWAddinCallBackObj As Object
	Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
	Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
	boolstatus = Part.Extension.SelectByID2("Plane4", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
	Part.SketchManager.InsertSketch True
	Part.ClearSelection2 True
	Dim skSegment As Object
	Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.002804, -0.014081, 0#)
	Part.ClearSelection2 True
	'Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.00453, -0.012735, 0#)
	Part.ClearSelection2 True
	Part.SketchManager.InsertSketch True

End Sub

The routine picks the appropriate plane, starts a sketch and, inserts a circle sketch on the plane. To create the circle the computer needs 2 points, a center point and a point along the circle (X _Center, Y_Center, Z_Center, X_Point, Y_Point, Z_Point). The sub creates two circles but when the second circle creates a bug later in the code and is commented out.

Tube Creation

Front Triangle

To do the extrusions on the front triangle of the bike the macro needed a sketch and a distance the extrude the sketch by. The sketches were made in the previous step and can be selected when extruding. To get the length of the extrusion a function was written that takes two points (X, Y) and finds the magnitude between the two points. Below is the function Mag_Line that performs this action:

Public Function Mag_Line(ByVal X1 As Double, ByVal X2 As Double, ByVal Y1 As Double, ByVal Y2 As Double) As Double

Mag_Line = Sqrt((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)

End Function

Once this calculation is executed for each tube in the front triangle the results along with the sketches can be used to create a tube. Below is an example of this action:

Public Sub Extrude_tubes(ST_mag As Double, TT_mag As Double, HT_mag As Double, DT_mag As Double)

    Set swApp = Application.SldWorks
    
    Set Part = swApp.ActiveDoc
    Dim COSMOSWORKSObj As Object
    Dim CWAddinCallBackObj As Object
    Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
    Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
    boolstatus = Part.Extension.SelectByID2("Arc1@Sketch7", "EXTSKETCHSEGMENT", -3.98637184376291E-07, -1.62285201987454E-02, 0, False, 0, Nothing, 0)
    Dim myFeature As Object
    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, ST_mag, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
    Part.SelectionManager.EnableContourSelection = True
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Arc1@Sketch8", "EXTSKETCHSEGMENT", -1.43574711165002E-02, -3.72642896425464E-07, 0, False, 0, Nothing, 0)
    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, TT_mag, 0.5, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
    Part.SelectionManager.EnableContourSelection = False
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Arc1@Sketch9", "EXTSKETCHSEGMENT", 4.36022068779267E-07, -1.79037315889701E-02, 0, False, 0, Nothing, 0)
    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, HT_mag, 0.35, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
    Part.SelectionManager.EnableContourSelection = False
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Arc1@Sketch10", "EXTSKETCHSEGMENT", 1.59728933135786E-02, 4.39360427533446E-07, 0, False, 0, Nothing, 0)
    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, DT_mag, 0.14, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
    Part.SelectionManager.EnableContourSelection = False
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Arc1@Sketch14", "EXTSKETCHSEGMENT", -6.02232051055618E-03, -1.80730228702377E-02, 0, False, 0, Nothing, 0)
    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, 0.069, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
    Part.SelectionManager.EnableContourSelection = False
    Part.ClearSelection2 True

End Sub

Rear Triangle

A different approach was taken when creating the rear triangle as it has curved stays that change the complexity of the design. The stays use a 3D sketch to map out the area of the stays and the position of the circles this prevents the use of extrusion, but instead, a loft was used to follow the contour between circle sketches. After the loft is executed a mirroring routine is done to reflect the loft over the front face creating both stays. Below is an example of the code:

' Lofting Sub Routine

Public Sub SS_Loft(x As Double)

    Set swApp = Application.SldWorks
    
    Set Part = swApp.ActiveDoc
    Dim COSMOSWORKSObj As Object
    Dim CWAddinCallBackObj As Object
    Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
    Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
    boolstatus = Part.Extension.SelectByID2("Sketch11", "SKETCH", -1.09872233678415E-02, 3.0435130466546E-03, 0, False, 1, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch12", "SKETCH", -6.15949107034861E-03, -6.47800175627452E-03, 0, True, 1, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch13", "SKETCH", 5.69283104152764E-03, -1.01077976464676E-03, 0, True, 1, Nothing, 0)
    Part.FeatureManager.InsertProtrusionBlend False, True, False, 1, 6, 6, 1, 1, True, True, False, 0, 0, 0, True, True, True
    boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0)


End Sub

' Mirroring Sub Routine

Public Sub SS_Mirror(x As Double)

    Set swApp = Application.SldWorks
    
    Set Part = swApp.ActiveDoc
    Dim COSMOSWORKSObj As Object
    Dim CWAddinCallBackObj As Object
    Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
    Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
    
    Part.ClearSelection2 True
    boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 2, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Loft1", "BODYFEATURE", 0, 0, 0, True, 1, Nothing, 0)
    
    Dim myFeature As Object
    Set myFeature = Part.FeatureManager.InsertMirrorFeature(False, False, False, False)
    
End Sub

Hiding Sketches

This step hides all of the referencing sketches in the model. Below is an example of the code:

Public Sub Hide_sketches(x As Double)

    Set swApp = Application.SldWorks
    
    Set Part = swApp.ActiveDoc
    Dim COSMOSWORKSObj As Object
    Dim CWAddinCallBackObj As Object
    Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
    Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
    
    boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("3DSketch1", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch6", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch5", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch4", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch3", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    boolstatus = Part.Extension.SelectByID2("Sketch2", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
    Part.BlankSketch
    Part.ClearSelection2 True

End Sub

Full Video of Macro

Future Plans

Macro File

	File	Modified
Labels No labels Preview View	File Bike.swp	Dec 17, 2020 by Former user

List of Contributors: