Hi all,
I have been searching all over to piece together a macro that saves the open drawing as a DWG in a specific folder, while adding the "DESCRIPTION" custom property to the file name.
I started with recording a macro (see below), saving as DWG to the desired directory... then tried adding different code from this forum, but nothing really worked. Any ideas? Thanks
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 Part = swApp.ActiveDoc
' Zoom To Fit
Part.ViewZoomtofit2
Part.ClearSelection2 True
boolstatus = Part.EditRebuild3()
' Redraw
Part.GraphicsRedraw2
' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
' Zoom to Area
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
' Zoom To Fit
Part.ViewZoomtofit2
' Redraw
Part.GraphicsRedraw2
' Save As
longstatus = Part.SaveAs3("H:\SHARED FILES\Purchasing\~DWG Library\2451587326.DWG", 0, 0)
End Sub
Ok, I am able get the custom property into the file name, but I still cant figure out how to save to the appropriate directory.
This is what I have so far:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Fileprop As String
Dim Filepath As String
Dim FileName As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Fileprop = swModel.CustomInfo("DWG")
Filepath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
FileName = Left(swModel.GetTitle, Len(swModel.GetTitle) - 9)
swModel.SaveAs (Filepath + FileName + Fileprop + ".DWG")
End Sub