Description

This macro creates a feature-driven pattern for all selected components in an assembly. The last selection in the list is used as the driving pattern, such as a hole feature.

System Requirements

• SolidWorks Version: SolidWorks 2014 or newer
• Operating System: Windows 7 or later

Pre-Conditions

• An assembly document must be open in SolidWorks.
• Multiple components and a feature to drive the pattern must be selected in the order required.

Results

• A derived component pattern will be created in the assembly based on the selected driving feature.

Steps to Set Up and Run the Macro

Follow these steps to outline the process, from the initial one-time file setup to the routine execution of the Feature-Driven Component Pattern utility.

• Register and Save the Macro File (One-time Setup):
  • Go to Tools > Macro > New… in SOLIDWORKS.Give the macro file a descriptive name (e.g., FeatureDrivenPattern.swp) and it will save and automatically open the VBA editor.Paste the Code: Paste the code provided in the code window of the editor. This setup is essential when creating or using a SolidWorks macro for feature driven component pattern.
• Register and Save the Macro File (One-time Setup):
  • Go to Tools > Macro > New… in SOLIDWORKS.Give the macro file a descriptive name (e.g., FeatureDrivenPattern.swp) and it will save and automatically open the VBA editor.Paste the Code: Paste the code provided in the code window of the editor
• Prepare the Selections (Execution Pre-condition):
  • In the assembly that is currently active, select all target components to be patterned.
• Execute the Macro: Once the components are specified and the driving feature is selected, execute the macro via Tools > Macro > Run, or by using the keyboard shortcut assigned to it. The macro will immediately create the feature-driven component pattern.

VBA Macro Code

' Disclaimer:
' The code provided should be used at your own risk.  
' Blue Byte Systems Inc. assumes no responsibility for any issues or damages that may arise from using or modifying this code.  
' For more information, visit [Blue Byte Systems Inc.](https://bluebyte.biz).

Option Explicit

Dim swApp As Object                          ' SolidWorks application object
Dim Part As Object                           ' Active document object
Dim SelMgr As Object                         ' Selection manager for the active document
Dim boolstatus As Boolean                    ' Boolean status for operations
Dim longstatus As Long, longwarnings As Long ' Long status for warnings/errors
Dim Feature As Object                        ' Feature object
Dim CurSelCount As Long                      ' Count of selected items

Sub main()

    ' Initialize SolidWorks application and active document
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc

    ' Ensure there is an active document
    If Part Is Nothing Then
        MsgBox "No active document found. Please open a part or assembly and try again.", vbCritical, "Error"
        Exit Sub
    End If

    ' Initialize the selection manager
    Set SelMgr = Part.SelectionManager

    ' Disable input dimensions on creation
    swApp.SetUserPreferenceToggle swInputDimValOnCreate, False

    ' Check if a plane or face is preselected
    CurSelCount = SelMgr.GetSelectedObjectCount
    If CurSelCount = 0 Then
        MsgBox "Please preselect a plane or face before running the macro.", vbExclamation, "No Selection"
        Exit Sub
    End If

    ' Insert a new sketch on the selected plane or face
    boolstatus = Part.Extension.SelectByID2("", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    Part.InsertSketch2 True
    Part.ClearSelection2 True

    ' Create a rectangle centered about the origin
    Part.SketchRectangle -0.037, 0.028, 0, 0.015, -0.019, 0, True

    ' Clear selection and add a diagonal construction line
    Part.ClearSelection2 True
    Dim Line As Object
    Set Line = Part.CreateLine2(-0.037, -0.019, 0, 0.015, 0.028, 0)
    Line.ConstructionGeometry = True

    ' Add midpoint constraints to ensure the rectangle is centered
    boolstatus = Part.Extension.SelectByID2("Point1@Origin", "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
    Part.SketchAddConstraints "sgATMIDDLE"
    Part.ClearSelection2 True

    ' Add dimensions to the rectangle
    boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -0.001, 0.027, 0, False, 0, Nothing, 0)
    Dim Annotation As Object
    Set Annotation = Part.AddDimension2(-0.0004, 0.045, 0) ' Horizontal dimension
    Part.ClearSelection2 True

    boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", -0.030, 0.001, 0, False, 0, Nothing, 0)
    Set Annotation = Part.AddDimension2(-0.061, -0.001, 0) ' Vertical dimension
    Part.ClearSelection2 True

    ' Re-enable input dimensions on creation
    swApp.SetUserPreferenceToggle swInputDimValOnCreate, True

    ' Inform the user that the macro is complete
    MsgBox "Rectangle sketch created successfully.", vbInformation, "Success"

End Sub

Macro

You can download the macro from here.

Build More Effective Custom Solutions With Our Team Of Experts!

Contact us today to discuss your custom automation solutions – and beyond!