Joris Vis

Reverse traverse Assembly array

Discussion created by Joris Vis on Nov 11, 2019
Latest reply on Nov 28, 2019 by Joris Vis



I am reading allong for a while but now I can't seem to find an anwser. 


I've made a macro that can be used in an assembly. (Stil rough concept) 

It traverses through the assembly and sub-assemblies, opens every document rebuilds it, saves it and closes. 

It works great but the problem is that it goes from the top to bottom level. 

So if it is done all the sub assemblies would have to be rebuild again. 

How can I make it so it goes from the bottom to top level? 


I've looked to reverse the array but can't find any solution.  


This is the code



Option Explicit


Sub main()

Dim swApp As SldWorks.SldWorks

Dim SwModel As SldWorks.ModelDoc2

Dim swFeatMgr As SldWorks.FeatureManager

Dim swConfigMgr As SldWorks.ConfigurationManager

Dim swConfig As SldWorks.Configuration

Dim swRootComp As SldWorks.Component2

Dim bRet As Boolean

Dim nSuppressState As Long

Dim nResponse As Integer

Set swApp = Application.SldWorks

Set SwModel = swApp.ActiveDoc

Set swConfigMgr = SwModel.ConfigurationManager

Set swConfig = swConfigMgr.ActiveConfiguration
Set swRootComp = swConfig.GetRootComponent

Debug.Print "File = " & SwModel.GetPathName

         ProcessComponent swApp, SwModel, swRootComp, " "

End Sub




Sub ProcessComponent( _
swApp As SldWorks.SldWorks, _
SwModel As SldWorks.ModelDoc2, _
swComp As SldWorks.Component2, _
sPadStr As String)

Dim vChildCompArr As Variant

Dim vChildComp As Variant

Dim swChildComp As SldWorks.Component2

Dim nRetVal As Long

vChildCompArr = swComp.GetChildren

For Each vChildComp In vChildCompArr

      Set swChildComp = vChildComp

      Dim X As Integer
      X = InStrRev(swChildComp.Name, "-")

      Dim MdlInstnc As String
      MdlInstnc = Mid(swChildComp.Name, X + 1, Len(swChildComp.Name) - X)

      If MdlInstnc = 1 Then

         Debug.Print sPadStr & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & "> --> " &          swChildComp.GetPathName

            Rebuild_DOC (swChildComp.GetPathName) 'Module to rebuild document

               Dim DrwName As String
               DrwName = Left$(swChildComp.GetPathName, (Len(swChildComp.GetPathName) - 6)) & "SLDDRW"

               If Dir$(DrwName) <> "" Then

                  Debug.Print sPadStr & swChildComp.Name2 & "> --> " & DrwName
                  Rebuild_DOC (DrwName) 'Module to rebuild document

               End If

               ProcessComponent swApp, SwModel, swChildComp, sPadStr + " "

      End If
Next vChildComp

End Sub



Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Dim strPathAndFilename As String
Dim strResponse As String
Dim strFileType As Long
Dim longstatus As Long
Dim longwarnings As Long


Sub Rebuild_DOC(strPathAndFilename As String)

      Set swApp = Application.SldWorks

      strResponse = vbYes

         If StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDPRT", vbTextCompare) = 0 Then
               strFileType = swDocPART
         ElseIf StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDASM", vbTextCompare) = 0 Then
               strFileType = swDocASSEMBLY
         ElseIf StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDDRW", vbTextCompare) = 0 Then
               strFileType = swDocDRAWING
         End If

               Set SwModel = swApp.OpenDoc6(strPathAndFilename, strFileType, swOpenDocOptions_Silent, "",                      longstatus, longwarnings)
               'Set SwModel = swApp.ActivateDoc2(strPathAndFilename, True, longstatus)

If (SwModel.IsOpenedReadOnly = "False") Then

         If (SwModel.GetType <> swDocDRAWING) Then

               'swModel.ShowNamedView2 "*Isometric", 7
                SwModel.ShowNamedView2 "*Trimetric", 8

         End If

               'Rebuild File
                SwModel.ForceRebuild '[Ctrl]+Q

               'Zoom to extents

                 SwModel.Save2 False


' Else
      ' strResponse = MsgBox("The file is Read-Only." & Chr(13) & "Do you want to close the file without Saving?",          vbCritical + vbYesNo, "FileOpenRebuildSaveClose")
End If

Set SwModel = Nothing

If (strResponse = vbYes) Then
         swApp.CloseDoc strPathAndFilename
End If

Set swApp = Nothing

End Sub