AnsweredAssumed Answered

VBA - Replace Multiple Selected Components

Question asked by Cad Admin on Dec 20, 2018
Latest reply on Jan 15, 2019 by Cad Admin

  I have a case I need to replace multiple details in an assembly with a known set of replacement parts. I would like to either select the parts from the feature tree or the model window. Files are in a known path. (Attached zip has reference part files & assembly file)


This version, selection is only handled from the feature tree


My issue is …if I select any 1 single file it works fine, if I select more than 1 file the macro runs, but replace ALL parts with the same part.



Original files





Replace With





Macro of what i have is below...


Option Explicit


Option Compare Text


    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim activeModel             As SldWorks.ModelDoc2

    Dim swAssy                  As SldWorks.AssemblyDoc

    Dim swSelMgr                As SldWorks.SelectionMgr

    Dim swSelComp               As SldWorks.Component2

    Dim swSelModel              As SldWorks.ModelDoc2

    Dim vChildComp              As Variant

    Dim swChildComp             As SldWorks.Component2

    Dim sPadStr                 As String

    Dim i                       As Long

    Dim CfgName                 As String

    Dim FileName                As String

    Dim bRet                    As Boolean

    Dim nErrors                 As Long

    Dim ret                     As Long


    Dim swCompModel             As ModelDoc2

    Dim boolstatus              As Boolean


    Dim swModelDocExt           As SldWorks.ModelDocExtension

    Dim IsToolBoxPart           As Boolean



Sub mainA()


    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    Set swAssy = swModel


    boolstatus = swApp.SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swViewTransitionHideShowComponent, 0)


    Dim LWerrors As Long

    LWerrors = swModel.ResolveAllLightWeightComponents(False)


    If swModel Is Nothing Then

        MsgBox "No active Assembly document"

        Exit Sub

    End If


    If swModel.GetType <> 2 Then

        MsgBox "No active Assembly document"

        Exit Sub

    End If


    Set swSelMgr = swModel.SelectionManager


    If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then

        MsgBox "No selected component", vbExclamation

        Exit Sub

    End If


    Dim selCount As Integer

        selCount = swSelMgr.GetSelectedObjectCount2(-1)


        selCount = selCount - 1


            Dim i As Integer


            For i = 0 To selCount


                Set swSelComp = swSelMgr.GetSelectedObject6(i + 1, -1)


                Set swCompModel = swSelComp.GetModelDoc2

                Debug.Print swSelComp.Name2


                If swSelComp.IsSuppressed = False Then

                    ret = swCompModel.Extension.ToolboxPartType

                End If


                If ret <> 0 Then

                    MsgBox "Part selected is NOT a fastener", vbExclamation

                Exit Sub

                End If


                If ret = 0 Then


                    FileName = ""

                    CfgName = ""

                    CfgName = swSelComp.ReferencedConfiguration


                    If InStr(swSelComp.Name2, "PartA-1") Then

                        FileName = "C:\Test Data\REF Package\PartB-1.sldprt"

                    End If


                    If InStr(swSelComp.Name2, "PartA-2") Then

                        FileName = "C:\Test Data\REF Package\PartB-2.sldprt"

                    End If


                    If InStr(swSelComp.Name2, "PartA-3") Then

                        FileName = "C:\Test Data\REF Package\PartB-3.sldprt"

                    End If


                    bRet = swAssy.ReplaceComponents2(FileName, CfgName, False, 0, True)

                    FileName = ""

                    CfgName = ""


                End If


End Sub