Description
This macro changes the unit system of all sub-parts and sub-assemblies in the active assembly to match the unit system of the main assembly. The macro ensures that all components in the assembly have a consistent unit system, which is crucial for accurate measurement and interoperability.
System Requirements
- SOLIDWORKS Version: SOLIDWORKS 2014 or newer
- Operating System: Windows 7 or later
Pre-requisites
To execute the macro, the following prerequisites must be satisfied:
- The active document must be an assembly document (.SLDASM) within SOLIDWORKS.
- The macro requires the necessary file permissions to the component files (.SLDPRT, .SLDASM) in order to execute open, edit and save actions.
Results
When executed, the unit consistency is enforced with the following results:
- All sub-parts and sub-assemblies in the assembly will have their unit system preferences set to that of the main assembly’s unit system.
- The changes are permanently saved to the individual component files.
- A final message box will show the updated unit system (e.g., MKS, MMGS, IPS) as confirmation for the user.
Steps to Set Up the Macro
- Registering a Macro File: Starting from open or closed SolidWorks, go to Tools > Macro > New…
- Naming the Macro File: To help identify your macro in the near future, a good practice is to name the macro in some relevant way. For example, you may want to give the file a name like “BatchUnitMatch.swp”. Once you have entered a name for the macro, press save. A new Window for the VBA editor should pop up.
- Place the Code: Simply download the VBA code provided below and then copy paste it into your editor.
- Execute The Macro: Exit from the editor and save when prompted. With the active target assembly, run the macro via Tools > Macro > Run, or by your previously assigned shortcut. This SOLIDWORKS macro to match component unit system helps enforce consistent units across all parts in your assembly, ensuring accuracy and uniformity in your design data.
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 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 |
' 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 ' Declare global variables Dim swApp As SldWorks.SldWorks ' SolidWorks application object Dim swmodel As SldWorks.ModelDoc2 ' Active model document (assembly) Dim swasm As SldWorks.AssemblyDoc ' Assembly document object Dim swconf As SldWorks.Configuration ' Configuration object Dim swrootcomp As SldWorks.Component2 ' Root component of the assembly Dim usys As Long ' Main assembly unit system Dim usys1 As Long ' Main assembly linear units Dim dunit As Long ' Dual linear unit system value Dim bret As Boolean ' Boolean return status variable Dim err As Long, war As Long ' Error and warning variables ' -------------------------------------------------------------------------- ' Main subroutine to initialize the process and update unit systems ' -------------------------------------------------------------------------- Sub main() ' Initialize SolidWorks application and get the active document Set swApp = Application.SldWorks Set swmodel = swApp.ActiveDoc ' Check if there is an active document open If swmodel Is Nothing Then MsgBox "No active document found. Please open an assembly and try again.", vbCritical, "No Active Document" Exit Sub End If ' Check if the active document is an assembly If swmodel.GetType <> swDocASSEMBLY Then MsgBox "This macro only works on assemblies. Please open an assembly and try again.", vbCritical, "Invalid Document Type" Exit Sub End If ' Get the active configuration and root component of the assembly Set swconf = swmodel.GetActiveConfiguration Set swrootcomp = swconf.GetRootComponent3(True) ' Get the main assembly's unit system and dual units usys = swmodel.GetUserPreferenceIntegerValue(swUnitSystem) ' Unit system (CGS, MKS, IPS, etc.) dunit = swmodel.GetUserPreferenceIntegerValue(swUnitsDualLinear) ' Dual linear unit system If usys = 4 Then usys1 = swmodel.GetUserPreferenceIntegerValue(swUnitsLinear) ' Custom linear units End If ' Traverse through all sub-components and update their unit systems Traverse swrootcomp, 1 ' Notify the user about the updated unit system Select Case usys Case 1 swApp.SendMsgToUser2 "Unit system changed to CGS", swMbInformation, swMbOk Case 2 swApp.SendMsgToUser2 "Unit system changed to MKS", swMbInformation, swMbOk Case 3 swApp.SendMsgToUser2 "Unit system changed to IPS", swMbInformation, swMbOk Case 4 swApp.SendMsgToUser2 "Unit system changed to Custom Unit", swMbInformation, swMbOk Case 5 swApp.SendMsgToUser2 "Unit system changed to MMGS", swMbInformation, swMbOk End Select End Sub ' -------------------------------------------------------------------------- ' Recursive function to traverse through the assembly and update unit systems ' -------------------------------------------------------------------------- Sub Traverse(swcomp As SldWorks.Component2, nlevel As Long) ' Declare necessary variables Dim vChildComp As Variant ' Array of child components in the assembly Dim swChildComp As SldWorks.Component2 ' Individual child component object Dim swCompConfig As SldWorks.Configuration ' Component configuration object Dim swpmodel As SldWorks.ModelDoc2 ' Model document object of the component Dim path As String ' Path of the component file Dim sPadStr As String ' String for formatting debug output Dim i As Long ' Loop counter for iterating through child components ' Format padding for debug output based on level For i = 0 To nlevel - 1 sPadStr = sPadStr + " " Next i ' Get child components of the current component vChildComp = swcomp.GetChildren ' Loop through each child component For i = 0 To UBound(vChildComp) Set swChildComp = vChildComp(i) ' Set the child component ' Recursively traverse through sub-components Traverse swChildComp, nlevel + 1 ' Check if the child component is valid If Not swChildComp Is Nothing Then path = swChildComp.GetPathName ' Get the path of the component ' Open the part or assembly based on file extension If (LCase(Right(path, 3)) = "prt") Then Set swpmodel = swApp.OpenDoc6(path, swDocPART, 0, swChildComp.ReferencedConfiguration, err, war) ElseIf (LCase(Right(path, 3)) = "asm") Then Set swpmodel = swApp.OpenDoc6(path, swDocASSEMBLY, 0, swChildComp.ReferencedConfiguration, err, war) End If ' If the component is successfully opened, update its unit system If Not swpmodel Is Nothing Then bret = swpmodel.SetUserPreferenceIntegerValue(swUnitSystem, usys) bret = swpmodel.SetUserPreferenceIntegerValue(swUnitsDualLinear, dunit) If usys = 4 Then bret = swpmodel.SetUserPreferenceIntegerValue(swUnitsLinear, usys1) End If ' Save the component after updating the unit system swpmodel.Save3 0, err, war Set swpmodel = Nothing ' Release the object End If End If Next i End Sub |
You can download the macro from here.
Need Help With Customization? Get Our Expert Support!
Our specialized team at Blue Byte Systems Inc. creates custom macros and add-ins to meet any of these advanced workflow requests.