-
Re: Macro to open the most recent part
Artem Taturevych Jan 9, 2013 4:56 PM (in response to Ian Barry)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
Tel: +61 2 9454 4444
-
Re: Macro to open the most recent part
Ian Barry Jan 9, 2013 8:45 PM (in response to Artem Taturevych)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 Jan 10, 2013 12:07 AM (in response to Ian Barry)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 Jan 10, 2013 9:35 AM (in response to Deepak Gupta)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
-
-
-