4 Replies Latest reply on Sep 26, 2013 10:52 PM by Keith Rice

    pack n go huge assembly problem vba

    Yannick Proulx

      Hi guys,

      I need your help once again

      I wrote down a code ( inspired by the help file) to pack and go an assembly an replace part of file name with someting else

      I use an excel sheet to build up my project and at the end of it I want to pack and go the full assembly and rename it

      the "template" assembly is called FBXGXXXXXX_NEW.SLDASM and the renamed project would be called FB4G53E888_NEW

       

      I tested my macro with a small assembly (111 parts and drawings) and it worked perfecly but when I tried it on the head assembly ( around 700 parts drawing not included) it doesn't seems to work

      I do not get any error code, the debugger get thru all the code without any problem but the pack and go do not create any part

      I first used  dim i as integer ... i tought it was the problem but even with dim i as long it do not work

       

       

       

      I'm kind of out of idea guys 

       

      There is maybe few stuff useless in the code, I ain't finish clean it out yet...so feel free to show me what is useless too !!

      also sorry for the few french work in the code, If you can't figure out what it means just send me a message and I will translate ( or maybe google translate may help)

       

       

      So you will find attached my XLSM file and right under this the source code of it

       

      Thanks for you help

      Your time is really appreciated

       

      Yannick

      Dim swApp As Object Dim pgSetFileNames() As String Dim swModelDoc As ModelDoc2 Dim swPackAndGo As SldWorks.PackAndGo Dim swModelDocExt As SldWorks.ModelDocExtension 'Dim fso As New FileSystemObject Sub main()         Set swApp = CreateObject("SldWorks.Application")         ActiveWorkbook.FollowHyperlink "c:\sw_travail\fbxgxxxxxx_new.sldasm"         Set swModelDoc = swApp.ActiveDoc         packAndGoAssembly         MsgBox "Done" End Sub   Public Function packAndGoAssembly() As String           Dim asmName As String         Dim i As Long         Set swModelDocExt = swModelDoc.Extension  ' Get Pack and Go object         Set swPackAndGo = swModelDocExt.GetPackAndGo()  ' Get number of documents in assembly         beforedrawincount = swPackAndGo.GetDocumentNamesCount ' just for my information                 swPackAndGo.IncludeDrawings = True         namesCount = swPackAndGo.GetDocumentNamesCount         Status = swPackAndGo.GetDocumentNames(pgFileNames)         Status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)         ' Create your own filenames for the model's documents         ReDim pgSetFileNames(namesCount - 1)         j = 0         For i = 0 To (namesCount - 1)                         myFileName = pgFileNames(i) no_remorque = Worksheets("feuil1").Range("g2").Value ' value is 53e888 nb = Worksheets("feuil1").Range("e2").Value ' value is 4 checkforfbx = "fbx" checkfor1fx = "1fx" checkfor2fx = "2fx"          If InStr(1, pgFileNames(i), checkforfbx) Then           replacement_nb = Replace(pgFileNames(i), checkforfbx, "fb" & nb) replacement_remorque = Replace(replacement_nb, "xxxxxx", no_remorque) myFileName = UCase(replacement_remorque)                           ElseIf InStr(1, pgFileNames(i), checkfor1fx) Then replacement_nb = Replace(pgFileNames(i), checkfor1fx, "1f" & nb) replacement_remorque = Replace(replacement_nb, "xxxxxx", no_remorque) myFileName = UCase(replacement_remorque)          ElseIf InStr(1, pgFileNames(i), checkfor2fx) Then         replacement_nb = Replace(pgFileNames(i), checkfor2fx, "2f" & nb) replacement_remorque = Replace(replacement_nb, "xxxxxx", no_remorque) myFileName = UCase(replacement_remorque) Else      GoTo suivant              End If pgSetFileNames(i) = myFileName suivant:         Next i         ' Set document paths and names for Pack and Go         Status = swPackAndGo.SetDocumentSaveToNames(pgSetFileNames)         ReDim pgGetFileNames(namesCount - 1)         ReDim pgDocumentStatus(namesCount - 1)         Status = swPackAndGo.GetDocumentSaveToNames(pgGetFileNames, pgDocumentStatus)         asmName = pgSetFileNames(0)         ' Pack and Go         statuses = swModelDocExt.SavePackAndGo(swPackAndGo)         Set part = swApp.ActiveDoc swApp.CloseDoc part.GetPathName openfile = "C:\sw_travail\FB" & nb & "G" & no_remorque & "_NEW" & ".sldasm" ActiveWorkbook.FollowHyperlink openfile     End Function