Hello,
Currently I am trying to edit my macro to make it work on all the drawings in a specific folder. I've read up on as many discussions I could find but I just can't seem to figure it out. I'll put the working code for one at a time and the current code I came up that is failing to work on multiple files in a folder. Any examples or reworks of the code required for it to work would be extremely helpful.
The macro that works for one at a time:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
'swCustPropMgr.Set "Revision Letter", "1"
swCustPropMgr.Set "Assembly #", "104500"
swCustPropMgr.Set "Checked Date", "11JUL18"
swCustPropMgr.Set "Check By", ""
swCustPropMgr.Set "Effective Date", "05MAY06"
swCustPropMgr.Set "EDR Approval Date", "25APR06"
swCustPropMgr.Set "EDR Originated By", ""
swCustPropMgr.Set "EDR #", "06-060"
'swCustPropMgr.Set "Revision Description", "ORIGINAL ISSUE"
boolstatus = Part.Extension.SelectByID2("Sheet1", "SHEET", 0.158120395359656, 1.18392865868883E-02, 0, False, 0, Nothing, 0)
Part.EditTemplate
Part.EditSketch
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 7.44302394941151E-03, 0.264739687978772, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SketchBoxSelect("-0.151307", "0.048840", "0.000000", "0.261962", "-0.205311", "0.000000")
Part.SetLineColor 0
boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 0.333181241811392, 1.37149385131569E-02, 0, False, 0, Nothing, 0)
Part.ViewZoomtofit2
Part.EditSheet
Part.EditSketch
Part.ClearSelection2 True
Part.ViewZoomtofit2
End Sub
Multiple files in a folder:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
Path = "C:\Users\grabiem\SWIM_work\EDR-06-060_104500\Drawings\"
sFileName = Dir(Path & "*.sldasm")
Do Until sFileName = ""
Set swModel = swApp.OpenDoc6(Path + sFileName, swDocASSEMBLY, swOpenDocOptions_Silent, "", nErrors, nWarnings)
'swCustPropMgr.Set "Revision Letter", "1"
swCustPropMgr.Set "Assembly #", "104500"
swCustPropMgr.Set "Checked Date", "11JUL18"
swCustPropMgr.Set "Check By", ""
swCustPropMgr.Set "Effective Date", "05MAY06"
swCustPropMgr.Set "EDR Approval Date", "25APR06"
swCustPropMgr.Set "EDR Originated By", ""
swCustPropMgr.Set "EDR #", "06-060"
'swCustPropMgr.Set "Revision Description", "ORIGINAL ISSUE"
boolstatus = Part.Extension.SelectByID2("Sheet1", "SHEET", 0.158120395359656, 1.18392865868883E-02, 0, False, 0, Nothing, 0)
Part.EditTemplate
Part.EditSketch
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 7.44302394941151E-03, 0.264739687978772, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SketchBoxSelect("-0.151307", "0.048840", "0.000000", "0.261962", "-0.205311", "0.000000")
Part.SetLineColor 0
boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 0.333181241811392, 1.37149385131569E-02, 0, False, 0, Nothing, 0)
Part.ViewZoomtofit2
Part.EditSheet
Part.EditSketch
Part.ClearSelection2 True
Part.ViewZoomtofit2
swApp.CloseDoc swModel.GetTitle
Set swModel = Nothing
sFileName = Dir
Loop
End Sub
Thanks,
Matt
SolidworksApi/macros