10 Replies Latest reply on Feb 20, 2017 8:32 AM by Deepak Gupta

    Run a macro on all files in a folder

    Axel Hedman

      Hi, I have a number of parts and assemblies i need to make drawings of.

      There is a monotone task of writing properties in all models and then make a drawing on each one.

       

      I want to make this process somewhat automated. So far I have managed to make this macro (I have no idea what Im doing, much copy and paste from this forum, but it seems to work.)

      I have found that schedule manager can make drawings from all parts, that sound good.

      However, I still don´t get how I make this macro run on all the files in one folder.

       

      Can someone help me?

       

      This is the code I want to run on all files:

       

      Dim swApp As SldWorks.SldWorks

      Dim swModel As ModelDoc2

       

      Sub main()

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

       

          'Check and Add/Update Number Property

          If swModel.CustomInfo("Number") = "" Then

            swModel.AddCustomInfo2 "Number", swCustomInfoText, (swModel.GetTitle)

          Else

              swModel.CustomInfo("Number") = (swModel.GetTitle)

          End If

         

          If swModel.CustomInfo("DrawnBy") = "" Then

            swModel.AddCustomInfo2 "DrawnBy", swCustomInfoText, "AHe / Devex"

          Else

              swModel.CustomInfo("DrawnBy") = "AHe / Devex"

          End If

         

          If swModel.CustomInfo("Surface finish") = "" Then

            swModel.AddCustomInfo2 "Surface finish", swCustomInfoText, "Ready for paint"

          Else

              swModel.CustomInfo("Surface finish") = "Ready for paint"

          End If

         

          If swModel.CustomInfo("General Tolerances") = "" Then

            swModel.AddCustomInfo2 "General Tolerances", swCustomInfoText, "SS-ISO 2768-1-m"

          Else

              swModel.CustomInfo("General Tolerances") = "SS-ISO 2768-1-m"

          End If

       

          If swModel.CustomInfo("Project") = "" Then

            swModel.AddCustomInfo2 "Project", swCustomInfoText, "P0988"

          Else

              swModel.CustomInfo("Project") = "P0988"

          End If

      End Sub

        • Re: Run a macro on all files in a folder
          Andreas Rhomberg

          have you looked at TASK, http://centralinnovation.com.au/  for writing all the Properties to the files.

          It is a free program and works well.

          • Re: Run a macro on all files in a folder
            John Stoltzfus

            Don't you use Custom Property Tab Builder ??

             

            I would use the attached macro written by Markku Lehtola

            • Re: Run a macro on all files in a folder
              Deepak Gupta

              Axel, yes you should be able to use the #TASK tool to run your own macros and can run on the entire folder (can also set which file type to run the macro on).

               

              I've also reduced the size of your macro. Add3 will add/update the properties with the required values.

               

              Option Explicit
              Dim swApp                        As SldWorks.SldWorks
              Dim swModel                      As SldWorks.ModelDoc
              Dim swCustProp              As CustomPropertyManager
              
              Sub main() 
                  Set swApp = Application.SldWorks
                  Set swModel = swApp.ActiveDoc
                  Set swCustProp = swModel.Extension.CustomPropertyManager("")
              
                  'Check and Add/Update Properties
                  swCustProp.Add3 "Number", 30, swModel.GetTitle, 1
                  swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1
                  swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1
                  swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1
                  swCustProp.Add3 "Project", 30, "P0988", 1
              
                  swModel.Save
              End Sub
              
              • Re: Run a macro on all files in a folder
                Axel Hedman

                Okay I tried #TASK but so far it does not seem to work. It only says that the part was not modified saving is skipped.

                However, when searching I found that this macro are supposed to open all parts in a specific folder

                 

                1. Dim swApp As SldWorks.SldWorks 
                2. Dim swDoc As ModelDoc2 
                3. Dim fileerror As Long 
                4. Dim filewarning As Long 
                5.  
                6. Const folder As String = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\" 
                7. Dim files As Variant 
                8.      
                9. Sub main() 
                10.     Set swApp = Application.SldWorks 
                11.     files = Dir(folder & "*.sldprt", vbNormal) 
                12.     Do While files <> "" 
                13.         swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning 
                14.         files = Dir 
                15.     Loop 
                16. End Sub

                But I don´t get what is what, can i put my macro somwhere in that macro?

                That macro is from this thread: Run Macro in Task Scheduler

                  • Re: Run a macro on all files in a folder
                    Deepak Gupta

                    Not sure why #TASK would fail. Anyway try these codes

                     

                    Option Explicit
                     Dim swApp              As SldWorks.SldWorks
                    Dim swModel            As SldWorks.ModelDoc2
                    Dim sFileName          As String
                    Dim Path                As String
                    Dim nErrors            As Long
                    Dim nWarnings          As Long
                    Dim swCustProp          As CustomPropertyManager
                    
                    Sub main()
                    On Error Resume Next
                    
                    Set swApp = Application.SldWorks
                    Path = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\" 'Change path here and make sure you include \ at end of path.
                    
                    sFileName = Dir(Path & "*.sldprt")
                    Do Until sFileName = ""
                    Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
                    Set swModel = swApp.ActiveDoc
                    Set swCustProp = swModel.Extension.CustomPropertyManager("") 
                    
                        'Check and Add/Update Properties 
                        swCustProp.Add3 "Number", 30, swModel.GetTitle, 1 
                        swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1 
                        swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1 
                        swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1 
                        swCustProp.Add3 "Project", 30, "P0988", 1
                    
                    swModel.Save3 swSaveAsOptions_Silent, nErrors, nWarnings
                    swApp.CloseDoc swModel.GetTitle
                    Set swModel = Nothing
                    sFileName = Dir
                    Loop
                    End Sub
                    
                    • Re: Run a macro on all files in a folder
                      Artem Taturevych

                      Hi Axel,

                       

                      #TASK only saves the file when it sees it was modified. The AddCustomInfo2 API doesn't mark the model as dirty (i.e. modified). You can check this by running the macro on a active saved model and you will see that the * symbol is not added to the name and SOLIDWORKS doesn't ask you to save the model when you close it. You can forcibly set the dirty flag using SetSaveFlag API. In this case #TASK will successfully save the modified file. You simply need to add one line to the end of your macro.

                       

                        If swModel.CustomInfo("Project") = "" Then

                            swModel.AddCustomInfo2 "Project", swCustomInfoText, "P0988"

                          Else

                              swModel.CustomInfo("Project") = "P0988"

                          End If

                         

                          swModel.SetSaveFlag

                      Thanks,

                      Atrem

                    • Re: Run a macro on all files in a folder
                      Axel Hedman

                      Alright! I have started to get things going here!

                      I use the neat code i got from Deepak Gupta

                      1. Option Explicit 
                      2. Dim swApp                        As SldWorks.SldWorks 
                      3. Dim swModel                      As SldWorks.ModelDoc 
                      4. Dim swCustProp              As CustomPropertyManager 
                      5.  
                      6. Sub main()  
                      7.     Set swApp = Application.SldWorks 
                      8.     Set swModel = swApp.ActiveDoc 
                      9.     Set swCustProp = swModel.Extension.CustomPropertyManager(""
                      10.  
                      11.     'Check and Add/Update Properties 
                      12.     swCustProp.Add3 "Number", 30, swModel.GetTitle, 1 
                      13.     swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1 
                      14.     swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1 
                      15.     swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1 
                      16.     swCustProp.Add3 "Project", 30, "P0988", 1 
                      17.  
                      18.     swModel.Save 
                      19. End Sub

                      And by adding the swModel.SetSaveFlag I got from Artem Taturevych I got it to work with #TASK

                       

                      However! Now I want to make a new nuber from the existing part number:

                      I want 012.0067-00 to become 120067S0 ie I want to remove the first "0", then remove the "." and then change the "-0" to "S"

                      I have seen that its possible but i don´t get how it works :/