Macro feature to configure model dimensions
This VBA macro leverages functionality of macro feature to create custom model configurator for the specified dimensions.
Macro will build dynamic User Interface for the specified dimension and insert the Configurator feature directly in the Feature Manager tree.
Design can be modified at any time by clicking Edit Feature command
Feature can also be edited in the context of the assembly.
To insert the feature, pre-select dimensions you want to be configured and run the macro.
For each selected dimension specify the user friendly title (this will be displayed on the form):
Once inserted. Edit the definition of the feature to update the model.
Configurator feature can be inserted into the part or assembly (including inserting to the component edited in the context of the assembly).
Dimensions will be modified in the active configuration or in the referenced configuration of the component (if edited in context)
When adding configurator feature to the assembly it is possible to modify the dimensions of any sub-component.
Macro has an option to create a configuration for specified parameters. Once Create Configuration option is checked, specify the name of the configuration in the text box below.
When configuration is created for the component edited in the context of the assembly, referenced configuration of the component is automatically changed to a new configuration
Configuration
User can modify the constants below to change some of the parameters.
- BASE_NAME constants defines the default name used for the configurator feature
- EMBED_MACRO_FEATURE allows to embed the code directly to the model, so it is no longer linked to the original macro. This model can be shared with anyone and edited without the need to supply the original macro
Public Const BASE_NAME As String = "MyConfigurator" 'default name for the feature Const EMBED_MACRO_FEATURE As Boolean = True' embeds macro feature into the model
Benefits Comparison
Table below demonstrates the benefits of this approach compared to other poplar design automation methods and tools.
Note, the table below only shows benefits of this macro compared to other methods. Other methods have more benefits and features which this macro does not cover and those are not included into the table below
| Feature | This Macro | Equations | Design Table | DriveWorks |
|---|---|---|---|---|
| Easy to setup | ✓ | ✓ | ✓ | ✗ |
| Simple input method | ✓ | ✗ | ✗ | ✓ |
| Performance | ✓ | ✓ | ✗ | ✗ |
| On-demand editing | ✓ | ✓ | ✓ | ✗ |
| Sub-components support | ✓ | ✗ | ✗ | ✓ |
| In-context editing | ✓ | ✗ | ✗ | N/A |
| Extensibility | ✓ | ✗ | ✗ | ✓ |
Easy to setup
This criteria defines how quickly the configurator can be created. DriveWorks requires specific skills and rules engine to create a configurator, while this macro only requires dimensions preselection
Simple input method
This criteria defines how easy it is to apply and change the dimensions as per configurator input parameters. Both this macro and DriveWorks will use custom forms which simplifies the input while Equations and Design Table do not have a specific input form and it is required to search for the specific inputs through the list of other equations and definitions.
Performance
This criteria defines the execution performance (how long it takes before parameters are applied). This macro applies parameters instantly directly to dimension. Design Table needs to load Excel instance and open the file to recalculate and apply value. DriveWorks will always generate new model based on the specification inputs.
On-demand editing
This criteria defines if parameters can be changed to the existing design. DriveWorks generates new model and does not modify existing one.
Sub-components support
This criteria defines if parameters of the sub component can be modified. Although Equations can be defined for the components those are not configuration specific, i.e. it will not be possible to have two instances of the component with different configurations and different equation values.
In-context editing
This criteria defines if configuration of the component can be changed using in-context editing from the top level assembly. All of the methods except this macro requires the target component to be opened in its own window in order to be edited, while this macro allows in-context editing.
Extensibility
This criteria defines the possibility to extend the functionality beyond the out-of-the box functionality. Both Equations and DesignTable are built-in features. DriveWorks provides APIs and can be extended. This macro is open source and can be extended using SOLIDWORKS API.
Macro Setup
- Create new macro and copy the code below:
Type DimensionInfo
Name As String
title As String
Value As Double
End Type
Public Const MARGIN As Integer = 10
Public Const MAX_FORM_HEIGHT = 200
Public Const TEXT_BOX_WIDTH As Integer = 50
Public Const BASE_NAME As String = "Configurator"
Const EMBED_MACRO_FEATURE As Boolean = False
Sub main()
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
try_:
On Error GoTo catch_
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
If Not TypeOf swModel Is PartDoc And Not TypeOf swModel Is AssemblyDoc Then
Err.Raise vbError, "", "Only part and assembly documents are supported"
End If
Dim vParamNames As Variant
Dim vParamTypes As Variant
Dim vParamValues As Variant
If Not CollectParameters(swModel, vParamNames, vParamTypes, vParamValues) Then
Err.Raise vbError, "", "Please select dimensions to configure"
End If
Dim curMacroPath As String
curMacroPath = swApp.GetCurrentMacroPathName
Dim vMethods(8) As String
Dim moduleName As String
GetMacroEntryPoint swApp, curMacroPath, moduleName, ""
vMethods(0) = curMacroPath: vMethods(1) = moduleName: vMethods(2) = "swmRebuild"
vMethods(3) = curMacroPath: vMethods(4) = moduleName: vMethods(5) = "swmEditDefinition"
vMethods(6) = curMacroPath: vMethods(7) = moduleName: vMethods(8) = "swmSecurity"
Dim opts As swMacroFeatureOptions_e
If EMBED_MACRO_FEATURE Then
opts = swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile
Else
opts = swMacroFeatureOptions_e.swMacroFeatureByDefault
End If
Dim swFeat As SldWorks.Feature
Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
Empty, opts)
If swFeat Is Nothing Then
Err.Raise vbError, "", "Failed to create box feature"
End If
Else
Err.Raise "Please open model"
End If
GoTo finally_
catch_:
MsgBox Err.Description, vbCritical, "Configurator"
finally_:
End Sub
Function CollectParameters(model As SldWorks.ModelDoc2, ByRef vParamNames As Variant, ByRef vParamTypes As Variant, ByRef vParamValues As Variant) As Boolean
Dim paramNames() As String
Dim paramTypes() As Long
Dim paramValues() As String
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = model.SelectionManager
Dim i As Integer
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelDIMENSIONS Then
Dim swDispDim As SldWorks.DisplayDimension
Set swDispDim = swSelMgr.GetSelectedObject6(i, -1)
Dim swComp As SldWorks.Component2
Set swComp = swSelMgr.GetSelectedObjectsComponent3(i, -1)
If (Not paramNames) = -1 Then
ReDim paramNames(0)
ReDim paramTypes(0)
ReDim paramValues(0)
Else
ReDim Preserve paramNames(UBound(paramNames) + 1)
ReDim Preserve paramTypes(UBound(paramTypes) + 1)
ReDim Preserve paramValues(UBound(paramValues) + 1)
End If
Dim paramName As String
paramName = ""
If Not swComp Is Nothing Then
paramName = swComp.Name2
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = model
Dim swEditTargetComp As SldWorks.Component2
Set swEditTargetComp = swAssy.GetEditTargetComponent
If Not swEditTargetComp Is Nothing Then
If Not swEditTargetComp.GetModelDoc2() Is swAssy Then
If Left(paramName, Len(swEditTargetComp.Name2)) <> swEditTargetComp.Name2 Then
Err.Raise vbError, "", "Dimension must belong to the current edit target"
End If
If LCase(paramName) = LCase(swEditTargetComp.Name2) Then
paramName = ""
Else
paramName = Right(paramName, Len(paramName) - Len(swEditTargetComp.Name2) - 1)
End If
End If
End If
End If
paramName = paramName & IIf(paramName <> "", "/", "") & swDispDim.GetNameForSelection
paramNames(UBound(paramNames)) = paramName
paramValues(UBound(paramValues)) = InputBox("Specify the name for " & paramName, "Configurator", paramName)
paramTypes(UBound(paramTypes)) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString
End If
Next
vParamNames = paramNames
vParamTypes = paramTypes
vParamValues = paramValues
CollectParameters = (Not paramNames) <> -1
End Function
Sub GetMacroEntryPoint(app As SldWorks.SldWorks, macroPath As String, ByRef moduleName As String, ByRef procName As String)
Dim vMethods As Variant
vMethods = app.GetMacroMethods(macroPath, swMacroMethods_e.swMethodsWithoutArguments)
Dim i As Integer
If Not IsEmpty(vMethods) Then
For i = 0 To UBound(vMethods)
Dim vData As Variant
vData = Split(vMethods(i), ".")
If i = 0 Or LCase(vData(1)) = "main" Then
moduleName = vData(0)
procName = vData(1)
End If
Next
End If
End Sub
Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmRebuild = True
End Function
Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function
Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
try_:
On Error GoTo catch_
Dim swFeat As SldWorks.Feature
Set swFeat = varFeat
Dim title As String
title = "Edit " & swFeat.Name
Dim swMacroFeat As SldWorks.MacroFeatureData
Set swMacroFeat = swFeat.GetDefinition
Dim vParamNames As Variant
Dim vParamValues As Variant
swMacroFeat.GetParameters vParamNames, Empty, vParamValues
Dim swActiveModel As SldWorks.ModelDoc2
Set swActiveModel = varDoc
Dim confName As String
confName = swMacroFeat.CurrentConfiguration.Name
Dim dimsInfo() As DimensionInfo
dimsInfo = LoadDimensionValues(swActiveModel, confName, vParamNames, vParamValues)
ConfiguratorForm.Caption = title
ConfiguratorForm.EditDimensions dimsInfo, swActiveModel, confName
swmEditDefinition = True
GoTo finally_
catch_:
swmEditDefinition = False
MsgBox Err.Description, vbCritical, title
finally_:
End Function
Public Sub TrySetDimensions(dimsInfo() As DimensionInfo, model As SldWorks.ModelDoc2, targConfName As String, createConf As Boolean)
try_:
On Error GoTo catch_
Dim swTargModel As SldWorks.ModelDoc2
Dim swTargComp As SldWorks.Component2
If model.GetType() = swDocumentTypes_e.swDocASSEMBLY Then
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = model
Set swTargModel = swAssy.GetEditTarget
Set swTargComp = swAssy.GetEditTargetComponent
Else
Set swTargModel = model
End If
If createConf Then
Dim swConf As SldWorks.Configuration
If targConfName = "" Then
Err.Raise vbError, "", "Specify configuration name"
End If
Set swConf = swTargModel.ConfigurationManager.AddConfiguration2(targConfName, "", "", swConfigurationOptions2_e.swConfigOption_DontActivate, "", "", False)
If swConf Is Nothing Then
Err.Raise vbError, "", "Failed to add new configuration"
End If
End If
Dim i As Integer
For i = 0 To UBound(dimsInfo)
Dim dimInfo As DimensionInfo
dimInfo = dimsInfo(i)
Dim swDim As SldWorks.Dimension
Dim dimName As String
dimName = dimInfo.Name
Set swDim = GetDimension(swTargModel, dimName)
If Not swDim Is Nothing Then
Dim dimVal As Double
dimVal = dimInfo.Value
Dim confNames(0) As String
confNames(0) = targConfName
swDim.SetValue3 dimVal, swInConfigurationOpts_e.swSpecifyConfiguration, confNames
Else
Err.Raise vbError, "", dimName & " does not exist"
End If
Next
If createConf And Not swTargComp Is Nothing Then
swTargComp.ReferencedConfiguration = targConfName
End If
GoTo finally_
catch_:
MsgBox Err.Description, vbCritical, "Configurator"
finally_:
End Sub
Function GetDimension(model As SldWorks.ModelDoc2, dimName As String) As SldWorks.Dimension
Dim dimParts As Variant
dimParts = Split(dimName, "/")
Dim i As Integer
Dim swTargetModel As SldWorks.ModelDoc2
Set swTargetModel = model
Dim swCurComp As SldWorks.Component2
For i = 0 To UBound(dimParts) - 1
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swTargetModel
Set swCurComp = swAssy.GetComponentByName(dimParts(i))
Set swTargetModel = swCurComp.GetModelDoc2()
Next
Set GetDimension = swTargetModel.Parameter(dimParts(UBound(dimParts)))
End Function
Private Function LoadDimensionValues(model As SldWorks.ModelDoc2, confName As String, vParamNames As Variant, vParamValues As Variant) As DimensionInfo()
Dim swTargModel As SldWorks.ModelDoc2
If model.GetType() = swDocumentTypes_e.swDocASSEMBLY Then
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = model
Set swTargModel = swAssy.GetEditTarget
Else
Set swTargModel = model
End If
Dim dimsInfo() As DimensionInfo
ReDim dimsInfo(UBound(vParamNames))
Dim i As Integer
For i = 0 To UBound(vParamNames)
Dim swDim As SldWorks.Dimension
Dim dimName As String
dimName = CStr(vParamNames(i))
dimsInfo(i).Name = dimName
dimsInfo(i).title = vParamValues(i)
Set swDim = GetDimension(swTargModel, dimName)
If Not swDim Is Nothing Then
Dim dimVal As Double
Dim confNames(0) As String
confNames(0) = confName
dimVal = swDim.GetValue3(swInConfigurationOpts_e.swSpecifyConfiguration, confNames)(0)
dimsInfo(i).Value = dimVal
Else
Err.Raise vbError, "", dimName & " does not exist"
End If
Next
LoadDimensionValues = dimsInfo
End Function
Add new User Form and place the code below into the form's code behind
Dim lblParamName() As Label Dim txtParamValue() As TextBox Dim WithEvents chkCreateConf As CheckBox Dim txtConfName As TextBox Dim WithEvents btnApply As CommandButton Dim FeatDimsInfos() As DimensionInfo Dim swActiveModel As SldWorks.ModelDoc2 Dim FeatConfName As String Public Sub EditDimensions(dimsInfos() As DimensionInfo, activeModel As SldWorks.ModelDoc2, confName As String) LoadLayout dimsInfos, activeModel, confName Me.Show vbModeless End Sub Private Sub LoadLayout(dimsInfos() As DimensionInfo, activeModel As SldWorks.ModelDoc2, confName As String) FeatDimsInfos = dimsInfos FeatConfName = confName Set swActiveModel = activeModel Dim i As Integer Dim maxWidth As Integer ReDim lblParamName(UBound(FeatDimsInfos)) ReDim txtParamValue(UBound(FeatDimsInfos)) Dim nextPosY As Integer nextPosY = MARGIN For i = 0 To UBound(FeatDimsInfos) Dim dimInfo As DimensionInfo dimInfo = FeatDimsInfos(i) Set lblParamName(i) = Me.Controls.Add("Forms.Label.1") lblParamName(i).Caption = dimInfo.title & ":" lblParamName(i).Name = "lblLabel" & (i + 1) lblParamName(i).AutoSize = True lblParamName(i).Left = MARGIN lblParamName(i).Top = nextPosY If lblParamName(i).Width > maxWidth Then maxWidth = lblParamName(i).Width End If Set txtParamValue(i) = Me.Controls.Add("Forms.TextBox.1") txtParamValue(i).Width = TEXT_BOX_WIDTH txtParamValue(i).Name = "txtVal" & (i + 1) txtParamValue(i).Top = nextPosY txtParamValue(i).Text = dimInfo.Value nextPosY = nextPosY + MARGIN + lblParamName(i).height Next For i = 0 To UBound(txtParamValue) txtParamValue(i).Left = maxWidth + MARGIN * 2 Next Set chkCreateConf = Me.Controls.Add("Forms.CheckBox.1") chkCreateConf.Caption = "Create Configuration" chkCreateConf.Name = "chkCreateConf" chkCreateConf.Top = nextPosY + MARGIN chkCreateConf.Left = MARGIN Set txtConfName = Me.Controls.Add("Forms.TextBox.1") txtConfName.Name = "txtConfName" txtConfName.Top = chkCreateConf.Top + chkCreateConf.height + MARGIN txtConfName.Left = MARGIN txtConfName.Text = FeatConfName txtConfName.Enabled = chkCreateConf.Value Set btnApply = Me.Controls.Add("Forms.CommandButton.1") btnApply.Caption = "Apply" btnApply.Name = "btnApply" btnApply.Top = txtConfName.Top + txtConfName.height + MARGIN btnApply.Left = (maxWidth + MARGIN + TEXT_BOX_WIDTH) / 2 - btnApply.Width / 2 + MARGIN Dim height As Integer height = btnApply.Top + btnApply.height + MARGIN Me.StartUpPosition = 1 'center owner Me.ScrollBars = IIf(height > MAX_FORM_HEIGHT, fmScrollBarsVertical, fmScrollBarsNone) Me.ScrollHeight = height Me.Width = (maxWidth + MARGIN + TEXT_BOX_WIDTH) + MARGIN * 2 + 20 Me.height = IIf(height > MAX_FORM_HEIGHT, MAX_FORM_HEIGHT + 25, height + 25) 'including header height End Sub Private Sub chkCreateConf_Change() txtConfName.Enabled = chkCreateConf.Value End Sub Private Sub btnApply_Click() Dim targConfName As String If chkCreateConf.Value Then targConfName = txtConfName.Text Else targConfName = FeatConfName End If Dim i As Integer For i = 0 To UBound(FeatDimsInfos) Dim dimValTxt As String dimValTxt = txtParamValue(i).Text If IsNumeric(dimValTxt) Then FeatDimsInfos(i).Value = CDbl(dimValTxt) Else Err.Raise vbError, "", "Specified value for " & FeatDimsInfos(i).title & " is not numeric" End If Next TrySetDimensions FeatDimsInfos, swActiveModel, targConfName, chkCreateConf.Value End Sub
Specify the name for the form to be ConfiguratorForm. As the result the solution tree in VBA will look like below:
