Dim swSelComp() As SldWorks.Component2
    If swSelMgr.GetSelectedObjectCount2(-1) <> 0 Then
        ReDim swSelComp(swSelMgr.GetSelectedObjectCount2(-1) - 1) As SldWorks.Component2
    Else
        End
    End If




    Dim i As Integer
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelCOMPONENTS Then
            Set swSelComp(i - 1) = swSelMgr.GetSelectedObject6(i, -1)
        ElseIf swSelMgr.GetSelectedObjectType3(i, -1) = swSelFACES Then
            Set swSelComp(i - 1) = swSelMgr.GetSelectedObjectsComponent3(i, -1)
        Else
            MsgBox "Please selected a component."
            End
        End If
    Next i


    'Select front plane for inserting new part
    Dim swRefPlane As SldWorks.RefPlane
    Set swFeat = swModel.FirstFeature
    Do While Not swFeat Is Nothing
        If swFeat.GetTypeName = "RefPlane" Then
            Set swRefPlane = swFeat.GetSpecificFeature2
            Exit Do
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop



    'Get the root component name
    Dim swConfigMgr As SldWorks.ConfigurationManager
    Dim swConfig As SldWorks.Configuration
    Dim strRootCompName As String
    Set swConfigMgr = swModel.ConfigurationManager
    Set swConfig = swConfigMgr.ActiveConfiguration
    Set swComp = swConfig.GetRootComponent3(False)
    strRootCompName = swComp.Name2





    'Draw bounding box profile
    swModel.CreateLine2 vBox(0), vBox(4), 0, vBox(3), vBox(4), 0
    swModel.CreateLine2 vBox(3), vBox(4), 0, vBox(3), vBox(1), 0
    swModel.CreateLine2 vBox(3), vBox(1), 0, vBox(0), vBox(1), 0
    swModel.CreateLine2 vBox(0), vBox(1), 0, vBox(0), vBox(4), 0





    'Insert base extrude
    swModel.FeatureManager.FeatureExtrusion2 True, False, False, _
        swEndCondBlind, 0, dblDepth, 0, False, False, True, True, _
        0, 0, False, False, False, False, False, False, True, _
        swStartOffset, vBox(2), False






    'Delete InPlace mate to avoid assembly structure editing dialog box. _
        This searches for the last InPlacemate created.
    Dim swSubFeat As SldWorks.Feature
    Dim swInPlaceMateFeat As SldWorks.Feature
    swModel.Extension.SelectByID2 "Mates", "MATEGROUPS", 0, 0, 0, _
        False, 0, Nothing, 0
    Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
    Set swSubFeat = swFeat.GetFirstSubFeature
    While Not swSubFeat Is Nothing
        If InStr(1, swSubFeat.Name, "InPlace") <> 0 Then _
            Set swInPlaceMateFeat = swSubFeat
        Set swSubFeat = swSubFeat.GetNextSubFeature
    Wend
    swInPlaceMateFeat.Select2 False, 0
    swModel.EditDelete


    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        swComp.Visible = True
    Next i