4 Replies Latest reply on Jan 10, 2013 9:35 AM by Ian Barry

    Macro to open the most recent part

    Ian Barry

      I have a macro that opens all prt files in a directory and saves them as sldprt.  I have prt files that go all that go from .prt.1 up to .prt.200.  I want to forget about opening all previous files and focus just on the most recent.  Is there a way this can be done?

        • Re: Macro to open the most recent part
          Artem Taturevych

          Do you mean you like to interrupt your macro and then continue the process to not process the already processed files? If so you should create some sort of log text file and append every file path there. When macro runs it should read this file and skip the items already stored in this log.

          __________________________

          Regards,

          Artem Taturevych

          Application Engineer at Intercad

          http://intercad.com.au/

          Tel: +61 2 9454 4444

            • Re: Macro to open the most recent part
              Ian Barry

              What I was looking for was a macro to run through a file directory and find all like part numbers, but only grab the most recent and open that and save it as an sldprt.  So for example I have one part number say, ABCDE.prt.1, ABCDE.prt.2 and ABCDE.prt.3.  I want the macro to only open ABCDE.prt.3 and save it as ABCDE.sldprt then proceed to the next part number.  Im still fairly new to VBA in solidworks and have never used it to navigate through file directories.

                • Re: Macro to open the most recent part
                  Deepak Gupta

                  Ian Barry wrote:

                   

                  So for example I have one part number say, ABCDE.prt.1, ABCDE.prt.2 and ABCDE.prt.3. 

                   

                  This looks like the files are from ProE and not SolidWorks. You can use the purge option in ProE to clean up the files.

                    • Re: Macro to open the most recent part
                      Ian Barry

                      I have no experiance with proE, luckily my company just started the transition to solidwoks as I joined them.  I did a little reading as was able to solve my problem.  For those of you who care, the following macro opens the latest revised .prt file for each subfolder in a folder, creates new folders called sldprt and jpg in each subfolder. Then saves the part as a sldprt and jpg and puts them in their respected folder.

                       

                      Dim swApp As Object

                      Dim FSO As Object

                      'Place this macro in the folder where the prt files are you'd like to convert

                      'It will convert the lastest revision for each part into a sldprt and save it to a sldprt folder

                      'It will also take a picture and save it as a jpeg in a jpg folder

                       

                      Sub LoopFolders()

                       

                          Set swApp = Application.SldWorks

                          Set FSO = CreateObject("Scripting.FileSystemObject")

                          sPath = Left(swApp.GetCurrentMacroPathName(), InStrRev(swApp.GetCurrentMacroPathName(), "\"))

                          selectFiles sPath

                         Set FSO = Nothing

                       

                      End Sub


                      Sub selectFiles(sPath)

                       

                          Dim swModel As SldWorks.ModelDoc

                          Dim sFileName As String, ssPath As String, findFile As String

                          Dim modDate As String, sldprtSave As String, jpgSave As String

                          Dim Part As Object, myModelView As Object, activeModelView As Object, f As Object

                          Dim file As Object, Files As Object, Folder As Object, fFile As Object

                          Dim longstatus As Long, longwarnings As Long, i As Long, j As Long

                          Dim boolstatus As Boolean

                          Dim fldr

                          Dim checkDate As Date

                       

                          Set Folder = FSO.GetFolder(sPath)

                       

                          For Each fldr In Folder.SubFolders 'navigates through each subfolder until it gets to the last one

                              selectFiles fldr.Path

                          Next fldr

                       

                          ssPath = sPath & "\"

                          sFileName = Dir(ssPath & "*.prt.*")

                          Do Until sFileName = ""

                              For Each file In Folder.Files

                                  findFile = Left(sFileName, InStrRev(sFileName, ".prt", , vbTextCompare) - 1) & "*"

                                  checkDate = DateSerial(1950, 1, 1)

                       

                                  sldprtSave = ssPath & "sldprt" & "\"

                                  If Len(Dir(sldprtSave, vbDirectory)) = 0 Then 'creates sldprt folder if it dosent exist to save part into

                                      MkDir (sldprtSave)

                                 End If

                       

                                  jpgSave = ssPath & "jpg" & "\"

                                  If Len(Dir(jpgSave, vbDirectory)) = 0 Then 'creates jpg folder if it dosent exist to save part into

                                      MkDir (jpgSave)

                                  End If

                       

                                  For Each fFile In Folder.Files 'checks the modified date to find the lastest revised part

                                      If fFile Like findFile Then

                                          Set f = FSO.GetFile(fFile)

                                          modDate = f.DateLastModified

                                          If modDate > checkDate Then

                                              checkDate = modDate

                                              sFileName = fFile

                                          End If

                                      End If

                                  Next fFile

                       

                                  j = j + 1 'counter to count the number of parts

                                  boolstatus = swApp.LoadFile2(ssPath + sFileName, "B") 'opens the part and imports as geometry with knitting

                                  If boolstatus = True Then 'Checks if the part was able to load

                                      Set Part = swApp.ActiveDoc

                                     Set myModelView = Part.ActiveView

                                      Part.EditRebuild3

                                      Part.ShowNamedView2 "*Isometric", -1

                                      boolstatus = Part.Extension.InsertScene("\scenes\01 basic scenes\11 white kitchen ambient only.p2s") 'changes background to white

                                      Part.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayPlanes, False 'hides all planes

                                      myModelView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges 'adds edges to part

                                      Part.ViewZoomtofit2

                                      myModelView.FrameState = swWindowState_e.swWindowMaximized 'hides all toolbars for screenshot

                                      Part.SaveAs3 sldprtSave + Part.GetTitle + ".SLDPRT", 0, 0 'saves file as sldprt

                                      Part.SaveAs3 jpgSave + Part.GetTitle + ".JPG", 0, 0 'saves picture as jpg

                                      swApp.CloseDoc Part.GetTitle 'closes the file

                                      Else

                                      i = i + 1 'counts the number of parts that weren't able to be converted

                                  End If

                       

                                 Set swModel = Nothing

                                  sFileName = Dir

                                  Set swApp = Application.SldWorks

                             Next file

                         Loop

                          Temp = MsgBox(j - i & " parts of " & j & " parts successfully converted", vbOkayOnly, "Conversion Complete")

                      End Sub