How do I get this macro to pull the custom property "Revision" from the part file and not the drawing? I pieced this together from several macros and it works except where the information is pulled from. The macro is set to export a .step, .pdf, and .dwg with revision level to a specific folder.
Any help would be greatly appreciated!
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim Filepath As String
Dim FileName As String
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Dim CurrentRev As String
Dim entry As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
' If no model currently loaded, then exit
Exit Sub
End If
Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
Filepath = Left(Filepath, Len(Filepath) - 9) & "Documents\Mech Eng Docs\Rev Levels"
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7)
Filepath = Filepath + "\" + FileName ' Change Sub folder Name here
'FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
Filepath = Left(Filepath, Len(Filepath) - 3)
'swDraw.SaveAs (Filepath + FileName + ".PDF")
entry = InputBox("Enter Sheet Number ", "Sheet Number", Default)
Set part = swApp.ActiveDoc
Set myModelView = part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "", False, longstatus
Set part = swApp.ActiveDoc
part.ClearSelection2 True
Set myModelView = part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
FileName = Mid(part.GetPathName, InStrRev(part.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".step"
CurrentRev = swModel.GetCustomInfoValue("", "Revision")
If CurrentRev = "--" Then CurrentRev = "-Rev0" Else CurrentRev = "-Rev" & CurrentRev
part.SaveAs3 Filepath & entry & CurrentRev + ".step", 0, 0
Set swPart = Nothing
Set part = Nothing
swApp.CloseDoc ""
Set part = swApp.ActiveDoc
swDraw.SaveAs (Filepath + entry + CurrentRev + ".DWG")
swDraw.SaveAs (Filepath + entry + CurrentRev + ".pdf")
End Sub
Scott