Description
You can utilize the tool for the purpose of creating a rectangle that is centered about the origin, on a selected plane or face.
System Requirements
- SolidWorks Version: SolidWorks 2014 or newer
- Operating System: Windows 7 or later
Pre-requisites
- A plane or face must be pre-selected prior to starting the macro.
- SolidWorks must have an active document.
Results
- A centered rectangle will be drawn on the specified plane or face.
- The opposite corners of the rectangle will have a construction line drawn between them, which will be constrained to the origin.
- The rectangleās width and height will be created.
Steps to Set Up the Macro
- Choose a Plane or Face: In your SolidWorks document, pre-select the plane (e.g., Right Plane) or planar face on which the rectangle will be sketched.
- Execute the Macro: Now run the macro (preferably via an assigned keyboard shortcut for maximum speed). The centered rectangle and all related features will be completely created on the selected geometry. This SOLIDWORKS macro for instant centered rectangle sketching ensures that the sketch is generated quickly and precisely without manual alignment.
VBA Macro Code
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
' 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" |
Macro
You can download the macro fromĀ here.