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.

 

Example

Original files

PartA-1

PartA-2

PartA-3

 

Replace With

PartB-1

PartB-2

PartB-3

 

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

            Next

End Sub

Attachments

Outcomes