This is my code. It saves a PDF of a Solidworks drawing on our network drive. The problem is that the PDF sometimes has empty views. It will have the annotations, but not the view. I think if I cycled through the pages first, wait for the all to load, and then run the macro, the PDF will be correct. I know how to cycle through the drawings, but not wait for them to fully load. Can someone help me out?
Dim SwApp As SldWorks.SldWorks Dim Model As SldWorks.ModelDoc2 Dim MyPath, ModName, NewName, FolderName, FilePath, FileName As String Dim MB As Boolean Dim Errs As Long Dim Warnings As Long Const SW_SHOWNORMAL = 1 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Sub main()
Set SwApp = Application.SldWorks Set Model = SwApp.ActiveDoc
'checks to see if something is open If Model Is Nothing Then MB = MsgBox("No drawing loaded!", vbCritical) Exit Sub End If
'checks to make sure drawing is open If Model.GetType 3 Then SwApp.SendMsgToUser "Current document is not a drawing." Exit Sub End If
'check to make sure drawing has been saved FileName = Model.GetPathName If FileName = "" Then MB = MsgBox("Save Drawing First!", vbCritical) Exit Sub End If
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -
3) & ".pdf" 'gets file name & adds pdf extension FolderName = Left(ModName, 4) 'gets first 4 characters from file name
CreateDir "H:\DWGS\", Left(ModName, 4) 'creates folder in specified directory uncomment if needed
'only works if folder has already been manually created unless previous line is active MyPath = "H:\DWGS\" & FolderName & "\" & ModName
MB = Model.SaveAs4(MyPath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings) 'creates PDF
'error checking 'MsgBox "Errors: " & Errs & vbCrLf & "Warnings: " & Warnings If Warnings 0 Then MsgBox "There were warnings. PDF creation may have failed. Verify" & Chr(13) & "results and check possible causes.", vbExclamation If MB = False Then MsgBox "PDF creation has failed! Check save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
FilePath = "H:\DWGS\" & FolderName & "\" 'just gets path FileName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet")
- 3) 'just gets name retval = ShellExecute(1, "Open", FilePath & FileName & ".pdf", "", FilePath, SW_SHOWNORMAL) 'opens PDF after save
End Sub Sub CreateDir(Path As String, MyFolder As String) Dim stPath As String On Error Resume Next stPath = Path & "\" & MyFolder MkDir stPath End Sub