Macro to batch process a bunch of files in a directory
Macro to batch process a bunch of files in a directory
(OP)
Hi folks,
I'm chasing a macro to batch process the changing of the density in a whole bunch of part files.
I was thinking it would be as easy as recording a macro and getting task scheduler to batch it for me but it doesn't seem to give the option to apply it to any files or directories :(.
The trick, it would appear, is to parse through a directory pulling out all the *.sldprt files and modifying them as necessary. I lack the ability to write a macro to do this so I was wondering if anybody seen or got anything that could do this.
Cheers,
Dufus
I'm chasing a macro to batch process the changing of the density in a whole bunch of part files.
I was thinking it would be as easy as recording a macro and getting task scheduler to batch it for me but it doesn't seem to give the option to apply it to any files or directories :(.
The trick, it would appear, is to parse through a directory pulling out all the *.sldprt files and modifying them as necessary. I lack the ability to write a macro to do this so I was wondering if anybody seen or got anything that could do this.
Cheers,
Dufus






RE: Macro to batch process a bunch of files in a directory
There may be one you can use directly or modify to suit your needs.
RE: Macro to batch process a bunch of files in a directory
Density Manager macro and addin can change multiple parts within an assembly.
http://www.EsoxRepublic.com-SolidWorks API VB programming help
RE: Macro to batch process a bunch of files in a directory
Module 1
CODE
Dim swApp As Object
Dim swPart As Object
Dim swDwg As Object
Dim strNewLine3 As String
Const swDocDRAWING = 3
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swOpenDocOptions_Silent = &H1
Dim retval As Boolean, retval1 As Long, lngOha As Long
Dim sMask As String
Sub Main()
Dim sPath As String
Dim sFileSW As String
Dim sFileDWG As String
Dim sFileDXF As String
Dim sFilePRN As String
Dim sFileTitle As String
Dim iParts As Integer, iAssy As Integer, iDrw As Integer
Dim sMsg As String
sPath = BrowseForFolder(0, "Please select a Server folder.")
If sPath = "" Then
Exit Sub
Else
sPath = sPath & "\"
End If
sMsg = "Enter drawings mask (if applicable). Use '*' for all."
sMask = InputBox(sMsg, "Drawings Mask", "*")
If sMask = "" Then sMask = "*"
Set swApp = CreateObject("SldWorks.Application")
iParts = 0
iAssy = 0
iDrw = 0
'process parts
sFileSW = Dir(sPath & sMask & "*.sldprt")
Do While sFileSW <> ""
'Open file
Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocPART, False, False, True, lngOha)
If swPart Is Nothing Then
Call MsgBox("Unable to open document!", vbExclamation, "Line3") ' Display error message
End ' If no model currently loaded, then exit
End If
'counter
iParts = iParts + 1
'do part processing
'save file
retval1 = swPart.Save2(True)
'Close File
sFileTitle = swPart.GetTitle
swApp.CloseDoc sFileTitle
'Next File
sFileSW = Dir
Loop
'process assemblies
sFileSW = Dir(sPath & "*.sldasm")
Do While sFileSW <> ""
'Open file
Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocASSEMBLY, False, False, True, lngOha)
If swPart Is Nothing Then
Call MsgBox("Unable to open document!", vbExclamation, "Line3") ' Display error message
End ' If no model currently loaded, then exit
End If
'counter
iAssy = iAssy + 1
'do assembly processing
'save file
retval1 = swPart.Save2(True)
'Close File
sFileTitle = swPart.GetTitle
swApp.CloseDoc sFileTitle
'Next File
sFileSW = Dir
Loop
'process drawings
sFileSW = Dir(sPath & "*.slddrw")
Do While sFileSW <> ""
'Open file
Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocDRAWING, False, False, True, lngOha)
If swPart Is Nothing Then
Call MsgBox("Unable to open document!", vbExclamation, "Line3") ' Display error message
End ' If no model currently loaded, then exit
End If
'counter
iDrw = iDrw + 1
'do drawing processing
'save file
retval1 = swPart.Save2(True)
'Close File
sFileTitle = swPart.GetTitle
swApp.CloseDoc sFileTitle
'Next File
sFileSW = Dir
Loop
swApp.SendMsgToUser Str(iParts) & " parts, " & Str(iAssy) & "assemblies & " & Str(iDrw) & " drawings changed in folder" & vbCrLf & _
sPath & " !"
End Sub
Module 2
CODE
Option Explicit
Public Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
'declare variables to be used
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
'initialise variables
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'Call the browse for folder API
lpIDList = SHBrowseForFolder(udtBI)
'get the resulting string path
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
'If cancel was pressed, sPath = ""
BrowseForFolder = sPath
End Function
Module 2 is from the Tick or handleman
RE: Macro to batch process a bunch of files in a directory
RE: Macro to batch process a bunch of files in a directory
I'll do some cutting and pasting and see if I can get it to work. A star for you Dogarila :).