Skip to main content

Create MultiBoss-Extrude VBA macro feature using SOLIDWORKS API

Property Manager Page and preview for MultiBoss-Extrude Macro Feature { width=500 }

This VBA macro demonstrates how to create parametric SOLIDWORKS macro feature to create single extrude from multiple sketches using VBA.

Watch video below which demonstrates the macro and explains how macro was built and how it works.

{% youtube id: EAx78xOsU3s %}

Create the following macro structure and copy the code snippets to the corresponding modules and classes.

Macro modules and classes

Property Manager pages are defined in the SolidWorks {{Version}} exposed type library for add-in use type library. So it needs to be added to the references of the VBA macro.

VBA macro references

In order to add custom icons, download the Icons file and unzip into the Icons sub-folder next to the macro feature file

Macro Module

Entry point of the macro. Use this to insert new macro feature.

Dim swController As Controller

Sub main()

Set swApp = Application.SldWorks

Dim swModel As SldWorks.ModelDoc2

Set swModel = swApp.ActiveDoc

If Not swModel Is Nothing Then

Set swController = New Controller
swController.InsertExtrude

Else
MsgBox "Please open model"
End If

End Sub

Geometry Module

Module contains helper functions for building temp geometry of extrudes from input sketches

Dim swApp As SldWorks.SldWorks

Function CreateBodiesFromSketches(vSketches As Variant, vDepths As Variant) As Variant

Dim swBodies() As SldWorks.Body2

If Not IsEmpty(vSketches) Then

For i = 0 To UBound(vSketches)

Dim swSketchFeat As SldWorks.Feature
Set swSketchFeat = vSketches(i)

Dim depth As Double
depth = vDepths(i)

Dim swSketch As SldWorks.sketch
Set swSketch = swSketchFeat.GetSpecificFeature2

Dim vSkRegs As Variant
vSkRegs = swSketch.GetSketchRegions

If Not IsEmpty(vSkRegs) Then

Dim j As Integer

For j = 0 To UBound(vSkRegs)

Dim swSkReg As SldWorks.SketchRegion
Set swSkReg = vSkRegs(j)
Dim swBody As SldWorks.Body2
Set swBody = Geometry.ExtrudeRegion(swSkReg, depth)

If (Not swBodies) = -1 Then
ReDim swBodies(0)
Else
ReDim Preserve swBodies(UBound(swBodies) + 1)
End If

Set swBodies(UBound(swBodies)) = swBody

Next

End If

Next

End If

If (Not swBodies) <> -1 Then
CreateBodiesFromSketches = swBodies
Else
CreateBodiesFromSketches = Empty
End If

End Function

Private Function ExtrudeRegion(swSkRegion As SldWorks.SketchRegion, depth As Double) As SldWorks.Body2

Dim swBody As SldWorks.Body2
Set swBody = CreateBodyFromRegion(swSkRegion)

Set swApp = Application.SldWorks

Dim swModeler As SldWorks.Modeler
Set swModeler = swApp.GetModeler

Dim swFace As SldWorks.Face2
Set swFace = swBody.GetFaces()(0)
Dim swDir As SldWorks.MathVector

Dim swMathUtils As SldWorks.MathUtility
Set swMathUtils = swApp.GetMathUtility

Set swDir = swMathUtils.CreateVector(swFace.Normal)

Set ExtrudeRegion = swModeler.CreateExtrudedBody(swBody, swDir, depth)

End Function

Private Function CreateBodyFromRegion(swSkRegion As SldWorks.SketchRegion) As SldWorks.Body2

Set swApp = Application.SldWorks

Dim vCurves As Variant
vCurves = GetCurvesFromRegion(swSkRegion)

Dim swSketch As SldWorks.sketch
Set swSketch = swSkRegion.sketch

Dim swSurf As SldWorks.Surface
Set swSurf = CreatePlanarSurfaceFromSketch(swSketch)

Dim swBody As SldWorks.Body2
Set swBody = swSurf.CreateTrimmedSheet5(vCurves, True, 0.00001)

Set CreateBodyFromRegion = swBody

End Function

Private Function GetCurvesFromRegion(skReg As SldWorks.SketchRegion) As Variant

Dim swCurves() As SldWorks.Curve

Dim swLoop As SldWorks.Loop2
Set swLoop = skReg.GetFirstLoop()

While Not swLoop Is Nothing

Dim vLoopEdges As Variant
vLoopEdges = swLoop.GetEdges

If (Not swCurves) = -1 Then
ReDim swCurves(UBound(vLoopEdges))
Else
If UBound(swCurves) = -1 Then
ReDim swCurves(UBound(vLoopEdges))
Else
ReDim Preserve swCurves(UBound(swCurves) + UBound(vLoopEdges) + 2)
End If
End If

Dim i As Integer

For i = UBound(vLoopEdges) To 0 Step -1

Dim swLoopEdge As SldWorks.Edge
Set swLoopEdge = vLoopEdges(i)
Dim swCurve As SldWorks.Curve
Set swCurve = swLoopEdge.GetCurve().Copy
Set swCurves(UBound(swCurves) - UBound(vLoopEdges) + i) = swCurve

Next

Set swLoop = swLoop.GetNext

Wend

GetCurvesFromRegion = swCurves

End Function

Private Function CreatePlanarSurfaceFromSketch(sketch As SldWorks.sketch) As SldWorks.Surface

Dim swMathUtils As SldWorks.MathUtility
Set swMathUtils = swApp.GetMathUtility

Dim dPt(2) As Double
Dim dVec(2) As Double

Dim swRootPt As SldWorks.MathPoint
dPt(0) = 0: dPt(1) = 0: dPt(2) = 0
Set swRootPt = swMathUtils.CreatePoint(dPt)

Dim swNormVec As SldWorks.MathVector
dVec(0) = 0: dVec(1) = 0: dVec(2) = 1
Set swNormVec = swMathUtils.CreateVector(dVec)

Dim swRefVec As SldWorks.MathVector
dVec(0) = 1: dVec(1) = 0: dVec(2) = 0
Set swRefVec = swMathUtils.CreateVector(dVec)

Dim swSkTransform As SldWorks.MathTransform
Set swSkTransform = sketch.ModelToSketchTransform.Inverse

Set swRootPt = swRootPt.MultiplyTransform(swSkTransform)
Set swNormVec = swNormVec.MultiplyTransform(swSkTransform)
Set swRefVec = swRefVec.MultiplyTransform(swSkTransform)

Dim swModeler As SldWorks.Modeler
Set swModeler = swApp.GetModeler

Dim swSurf As SldWorks.Surface

Set swSurf = swModeler.CreatePlanarSurface2(swRootPt.ArrayData, swNormVec.ArrayData, swRefVec.ArrayData)

Set CreatePlanarSurfaceFromSketch = swSurf

End Function

MacroFeature Module

Implements the behavior of macro feature: regeneration and editing

Dim swController As Controller

Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swMacroFeatData As SldWorks.MacroFeatureData

Set swApp = varApp
Set swModel = varDoc
Set swFeat = varFeat

Set swMacroFeatData = swFeat.GetDefinition

Dim vSketches As Variant
Dim vDepths As Variant

swMacroFeatData.GetSelections3 vSketches, Empty, Empty, Empty, Empty
swMacroFeatData.GetParameters Empty, Empty, vDepths

Dim vBodies As Variant
vBodies = Geometry.CreateBodiesFromSketches(vSketches, vDepths)

Dim i As Integer

For i = 0 To UBound(vBodies)
Dim swBody As SldWorks.Body2
Set swBody = vBodies(i)
AssignUserIds swBody, swMacroFeatData
Next

swMacroFeatData.EnableMultiBodyConsume = True

swmRebuild = vBodies

End Function

Sub AssignUserIds(body As SldWorks.Body2, featData As SldWorks.MacroFeatureData)

Dim vFaces As Variant
Dim vEdges As Variant
Dim i As Integer

featData.GetEntitiesNeedUserId body, vFaces, vEdges

If Not IsEmpty(vFaces) Then
For i = 0 To UBound(vFaces)
Dim swFace As SldWorks.Face2
Set swFace = vFaces(i)
featData.SetFaceUserId swFace, 0, i
Next
End If

If Not IsEmpty(vEdges) Then
For i = 0 To UBound(vEdges)
Dim swEdge As SldWorks.Edge
Set swEdge = vEdges(i)
featData.SetEdgeUserId swEdge, 0, i
Next
End If

End Sub

Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant

If swController Is Nothing Then
Set swController = New Controller
End If

Dim swFeat As SldWorks.Feature
Set swFeat = varFeat

swController.EditExtrude swFeat

swmEditDefinition = True

End Function

Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmSecurity = swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function

PropertyPage Class Module

Implements the property manager page interface for the macro feature.

Implements PropertyManagerPage2Handler9

Public Event Closed(mode As Integer, vSketches As Variant, vDepths As Variant, isCancelled As Boolean)
Public Event DataChanged(vSketches As Variant, vDepths As Variant)

Dim swPage As PropertyManagerPage2
Dim swGroupBox() As PropertyManagerPageGroup
Dim swSelectionBox() As PropertyManagerPageSelectionbox
Dim swNumberBox() As PropertyManagerPageNumberbox

Const EXTRUDES_COUNT As Integer = 5

Const GroupStartID As Long = 1
Const SelectionBoxStartID As Long = GroupStartID + EXTRUDES_COUNT
Const NumberBoxStartID As Long = SelectionBoxStartID + EXTRUDES_COUNT

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Dim vSelSketches As Variant
Dim vDepthVals As Variant
Dim IsCancel As Boolean
Dim PageMode As Integer

Sub Show(Optional mode As Integer = -1, Optional vSketches As Variant = Empty, Optional vDepths As Variant = Empty)

PageMode = mode

Set swApp = Application.SldWorks

CreatePage

InitPageValues vSketches, vDepths

Const swPropertyManagerPageShowOptions_Default As Integer = 0

swPage.Show2 swPropertyManagerPageShowOptions_Default

Set swModel = swApp.ActiveDoc

End Sub

Sub CreatePage()

Dim errs As Long
Set swPage = swApp.CreatePropertyManagerPage("MultiBoss-Extrude", _
swPropertyManager_OkayButton + swPropertyManager_CancelButton, Me, errs)

If Not swPage Is Nothing Then

Dim i As Integer

Dim selMark As Integer

ReDim swGroupBox(EXTRUDES_COUNT - 1)
ReDim swSelectionBox(EXTRUDES_COUNT - 1)
ReDim swNumberBox(EXTRUDES_COUNT - 1)

For i = 0 To EXTRUDES_COUNT - 1

Dim grpOtps As Integer
grpOtps = swAddGroupBoxOptions_e.swGroupBoxOptions_Visible + swAddGroupBoxOptions_e.swGroupBoxOptions_Checkbox

If i = 0 Then
grpOtps = grpOtps + swAddGroupBoxOptions_e.swGroupBoxOptions_Expanded
End If

Set swGroupBox(i) = swPage.AddGroupBox(GroupStartID + i, "Extrude" & i + 1, grpOtps)

Set swSelectionBox(i) = swGroupBox(i).AddControl2(SelectionBoxStartID + i, _
swPropertyManagerPageControlType_e.swControlType_Selectionbox, "Region", _
swPropertyManagerPageControlLeftAlign_e.swControlAlign_LeftEdge, _
swAddControlOptions_e.swControlOptions_Enabled + swAddControlOptions_e.swControlOptions_Visible, "Select region to extrude")

Dim filters(0) As Long
filters(0) = swSelectType_e.swSelSKETCHES

swSelectionBox(i).SingleEntityOnly = True
swSelectionBox(i).Height = 30
swSelectionBox(i).SetSelectionFilters filters
swSelectionBox(i).Mark = 2 ^ i

Set swNumberBox(i) = swGroupBox(i).AddControl2(NumberBoxStartID + i, _
swPropertyManagerPageControlType_e.swControlType_Numberbox, "Extrude Depth", _
swPropertyManagerPageControlLeftAlign_e.swControlAlign_LeftEdge, _
swAddControlOptions_e.swControlOptions_Enabled + swAddControlOptions_e.swControlOptions_Visible, "")

swNumberBox(i).SetRange2 swNumberboxUnitType_e.swNumberBox_Length, 0.00001, 1000, False, 0.01, 0.1, 0.001
swNumberBox(i).Value = 0.01

Next

End If

End Sub

Sub InitPageValues(vSketches As Variant, vDepths As Variant)

If Not IsEmpty(vSketches) Then

Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True

Dim i As Integer

For i = 0 To UBound(vSketches)
Dim swSketchFeat As SldWorks.Feature
Set swSketchFeat = vSketches(i)
swSketchFeat.SelectByMark True, 2 ^ i
swGroupBox(i).Checked = True
swNumberBox(i).Value = CDbl(vDepths(i))
Next

End If

End Sub

Sub PropertyManagerPage2Handler9_AfterActivation()
End Sub

Sub PropertyManagerPage2Handler9_AfterClose()
Set swPage = Nothing
RaiseEvent Closed(PageMode, vSelSketches, vDepthVals, IsCancel)
End Sub

Function PropertyManagerPage2Handler9_OnActiveXControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
PropertyManagerPage2Handler9_OnActiveXControlCreated = 0
End Function

Sub PropertyManagerPage2Handler9_OnButtonPress(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnCheckboxCheck(ByVal Id As Long, ByVal Checked As Boolean)
End Sub

Sub PropertyManagerPage2Handler9_OnClose(ByVal Reason As Long)

IsCancel = Reason = swPropertyManagerPageCloseReasons_e.swPropertyManagerPageClose_Cancel

If Not IsCancel Then
CollectData vSelSketches, vDepthVals
End If

End Sub

Sub PropertyManagerPage2Handler9_OnComboboxEditChanged(ByVal Id As Long, ByVal Text As String)
End Sub

Sub PropertyManagerPage2Handler9_OnComboboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnGroupCheck(ByVal Id As Long, ByVal Checked As Boolean)
HandleDataChanged
End Sub

Sub PropertyManagerPage2Handler9_OnGroupExpand(ByVal Id As Long, ByVal Expanded As Boolean)
End Sub

Function PropertyManagerPage2Handler9_OnHelp() As Boolean
PropertyManagerPage2Handler9_OnHelp = True
End Function

Function PropertyManagerPage2Handler9_OnKeystroke(ByVal Wparam As Long, ByVal Message As Long, ByVal Lparam As Long, ByVal Id As Long) As Boolean
End Function

Sub PropertyManagerPage2Handler9_OnListboxSelectionChanged(ByVal Id As Long, ByVal Item As Long)
End Sub

Function PropertyManagerPage2Handler9_OnNextPage() As Boolean
PropertyManagerPage2Handler9_OnNextPage = True
End Function

Sub PropertyManagerPage2Handler9_OnNumberboxChanged(ByVal Id As Long, ByVal Value As Double)
HandleDataChanged
End Sub

Sub PropertyManagerPage2Handler9_OnOptionCheck(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnPopupMenuItem(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnPopupMenuItemUpdate(ByVal Id As Long, retVal As Long)
End Sub

Function PropertyManagerPage2Handler9_OnPreview() As Boolean
PropertyManagerPage2Handler9_OnPreview = True
End Function

Function PropertyManagerPage2Handler9_OnPreviousPage() As Boolean
PropertyManagerPage2Handler9_OnPreviousPage = True
End Function

Sub PropertyManagerPage2Handler9_OnRedo()
End Sub

Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutCreated(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutDestroyed(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnSelectionboxFocusChanged(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnSelectionboxListChanged(ByVal Id As Long, ByVal Count As Long)
HandleDataChanged
End Sub

Sub PropertyManagerPage2Handler9_OnSliderPositionChanged(ByVal Id As Long, ByVal Value As Double)
End Sub

Sub PropertyManagerPage2Handler9_OnSliderTrackingCompleted(ByVal Id As Long, ByVal Value As Double)
End Sub

Function PropertyManagerPage2Handler9_OnSubmitSelection(ByVal Id As Long, ByVal Selection As Object, ByVal SelType As Long, ItemText As String) As Boolean
PropertyManagerPage2Handler9_OnSubmitSelection = True
End Function

Function PropertyManagerPage2Handler9_OnTabClicked(ByVal Id As Long) As Boolean
PropertyManagerPage2Handler9_OnTabClicked = True
End Function

Sub PropertyManagerPage2Handler9_OnTextboxChanged(ByVal Id As Long, ByVal Text As String)
End Sub

Sub PropertyManagerPage2Handler9_OnUndo()
End Sub

Sub PropertyManagerPage2Handler9_OnWhatsNew()
End Sub

Sub PropertyManagerPage2Handler9_OnLostFocus(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnGainedFocus(ByVal Id As Long)
End Sub

Sub PropertyManagerPage2Handler9_OnListBoxRMBUp(ByVal Id As Long, ByVal posX As Long, ByVal posY As Long)
End Sub

Function PropertyManagerPage2Handler9_OnWindowFromHandleControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long
PropertyManagerPage2Handler9_OnWindowFromHandleControlCreated = 0
End Function

Sub PropertyManagerPage2Handler9_OnNumberboxTrackingCompleted(ByVal Id As Long, ByVal Value As Double)
End Sub

Sub HandleDataChanged()

Dim vCurSketches As Variant
Dim vCurDepths As Variant

CollectData vCurSketches, vCurDepths

RaiseEvent DataChanged(vCurSketches, vCurDepths)

End Sub

Sub CollectData(ByRef sketches As Variant, ByRef depths As Variant)

Dim swSketches() As SldWorks.Feature
Dim DepthVals() As Double

Dim i As Integer

For i = 0 To EXTRUDES_COUNT - 1

If False <> swGroupBox(i).Checked Then
If swSelectionBox(i).ItemCount > 0 Then

Dim selInd As Integer
selInd = swSelectionBox(i).SelectionIndex(0)

Dim swSketch As SldWorks.Feature
Set swSketch = swModel.SelectionManager.GetSelectedObject6(selInd, -1)

If (Not swSketches) = -1 Then
ReDim swSketches(0)
ReDim DepthVals(0)
Else
ReDim Preserve swSketches(UBound(swSketches) + 1)
ReDim Preserve DepthVals(UBound(DepthVals) + 1)
End If

Set swSketches(UBound(swSketches)) = swSketch
DepthVals(UBound(DepthVals)) = swNumberBox(i).Value

End If
End If

Next

If (Not swSketches) <> -1 Then
sketches = swSketches
depths = DepthVals
Else
sketches = Empty
depths = Empty
End If

End Sub

Controller Class Module

Connects the property manager page inputs to corresponding functionality (i.e. Edit or Insert)

Enum PageModes_e
Insert
Edit
End Enum

Const BASE_NAME As String = "MultiBoss-Extrude"

Dim swApp As SldWorks.SldWorks
Dim WithEvents swPage As PropertyPage
Dim swPreviewBodies As Variant

Dim swCurEditFeature As SldWorks.Feature
Dim swCurEditFeatureDef As SldWorks.MacroFeatureData

Private Sub Class_Initialize()
Set swApp = Application.SldWorks
Set swPage = New PropertyPage
End Sub

Public Sub InsertExtrude()
swPage.Show PageModes_e.Insert
End Sub

Public Sub EditExtrude(feat As SldWorks.Feature)

Set swCurEditFeature = feat
Set swCurEditFeatureDef = feat.GetDefinition

swCurEditFeatureDef.AccessSelections swApp.ActiveDoc, Nothing

Dim vSelection As Variant
swCurEditFeatureDef.GetSelections3 vSelection, Empty, Empty, Empty, Empty

Dim vParamValues As Variant
swCurEditFeatureDef.GetParameters Empty, Empty, vParamValues

swPage.Show PageModes_e.Edit, vSelection, vParamValues

Preview vSelection, vParamValues

End Sub

Private Sub swPage_Closed(mode As Integer, vSketches As Variant, vDepths As Variant, isCancelled As Boolean)

HidePreview

Select Case mode
Case PageModes_e.Insert
If Not isCancelled Then
InsertMacroFeature vSketches, vDepths
End If
Case PageModes_e.Edit
If Not isCancelled Then
ModifyMacroFeature vSketches, vDepths
Else
swCurEditFeatureDef.ReleaseSelectionAccess
End If
End Select

End Sub

Sub InsertMacroFeature(vSketches As Variant, vDepths As Variant)

Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc

Dim curMacroPath As String
curMacroPath = swApp.GetCurrentMacroPathName

Dim vMethods(8) As String

Const MACRO_FEATURE_MODULE_NAME As String = "MacroFeature"

vMethods(0) = curMacroPath: vMethods(1) = MACRO_FEATURE_MODULE_NAME: vMethods(2) = "swmRebuild"
vMethods(3) = curMacroPath: vMethods(4) = MACRO_FEATURE_MODULE_NAME: vMethods(5) = "swmEditDefinition"
vMethods(6) = curMacroPath: vMethods(7) = MACRO_FEATURE_MODULE_NAME: vMethods(8) = "swmSecurity"

Dim iconsDir As String
iconsDir = swApp.GetCurrentMacroPathFolder() & "\Icons\"

Dim icons(8) As String
icons(0) = iconsDir & "extrude_20x20.bmp"
icons(1) = iconsDir & "extrude-suppressed_20x20.bmp"
icons(2) = iconsDir & "extrude_20x20.bmp"

icons(3) = iconsDir & "extrude_32x32.bmp"
icons(4) = iconsDir & "extrude-suppressed_32x32.bmp"
icons(5) = iconsDir & "extrude_32x32.bmp"

icons(6) = iconsDir & "extrude_40x40.bmp"
icons(7) = iconsDir & "extrude-suppressed_40x40.bmp"
icons(8) = iconsDir & "extrude_40x40.bmp"

Dim vParamNames As Variant
Dim vParamTypes As Variant
Dim vParamValues As Variant

CreateParameters vDepths, vParamNames, vParamTypes, vParamValues

Dim swFeat As SldWorks.Feature
Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
icons, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile)

If swFeat Is Nothing Then
MsgBox "Failed to create feature"
End If

End Sub

Sub ModifyMacroFeature(vSketches As Variant, vDepths As Variant)

Dim vParamNames As Variant
Dim vParamTypes As Variant
Dim vParamValues As Variant

CreateParameters vDepths, vParamNames, vParamTypes, vParamValues
swCurEditFeatureDef.SetParameters vParamNames, vParamTypes, vParamValues

Dim swSelMarks() As Long
Dim swViews() As SldWorks.View

ReDim swSelMarks(UBound(vSketches))
ReDim swViews(UBound(vSketches))

swCurEditFeatureDef.SetSelections2 vSketches, swSelMarks, swViews

swCurEditFeature.ModifyDefinition swCurEditFeatureDef, swApp.ActiveDoc, Nothing

End Sub

Sub CreateParameters(vDepths As Variant, ByRef vParamNames As Variant, ByRef vParamTypes As Variant, ByRef vParamValues As Variant)

Dim sParamNames() As String
Dim iParamTypes() As Long
Dim dParamValues() As String

ReDim sParamNames(UBound(vDepths))
ReDim iParamTypes(UBound(vDepths))
ReDim dParamValues(UBound(vDepths))

Dim i As Integer
For i = 0 To UBound(vDepths)
sParamNames(i) = "DEPTH" & i + 1
iParamTypes(i) = swMacroFeatureParamType_e.swMacroFeatureParamTypeDouble
dParamValues(i) = CStr(vDepths(i))
Next

vParamNames = sParamNames
vParamTypes = iParamTypes
vParamValues = dParamValues

End Sub

Private Sub swPage_DataChanged(vSketches As Variant, vDepths As Variant)
Preview vSketches, vDepths
End Sub

Sub Preview(vSketches As Variant, vDepths As Variant)

HidePreview

swPreviewBodies = Geometry.CreateBodiesFromSketches(vSketches, vDepths)

If Not IsEmpty(swPreviewBodies) Then

Dim i As Integer

For i = 0 To UBound(swPreviewBodies)
Dim swBody As SldWorks.Body2
Set swBody = swPreviewBodies(i)
swBody.Display3 swApp.ActiveDoc, RGB(255, 255, 0), swTempBodySelectOptions_e.swTempBodySelectOptionNone
Next

End If

End Sub

Sub HidePreview()

Dim i As Integer

If Not IsEmpty(swPreviewBodies) Then

For i = 0 To UBound(swPreviewBodies)
Set swPreviewBodies(i) = Nothing
Next

End If

End Sub

Download sample model