Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim strPathAndFilename As String
Dim strResponse As String
Dim strFileType As Long
Dim longstatus As Long
Dim longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
strPathAndFilename = "C:\Temp\Part1.SLDDRW"
strResponse = vbYes
If StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDPRT", vbTextCompare) = 0 Then
strFileType = swDocPART
ElseIf StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDASM", vbTextCompare) = 0 Then
strFileType = swDocASSEMBLY
ElseIf StrComp((UCase$(Right$(strPathAndFilename, 7))), ".SLDDRW", vbTextCompare) = 0 Then
strFileType = swDocDRAWING
End If
Set swModel = swApp.OpenDoc6(strPathAndFilename, strFileType, 0, "", longstatus, longwarnings)
Set swModel = swApp.ActivateDoc2(strPathAndFilename, False, longstatus)
If (swModel Is Nothing) Then
strResponse = MsgBox("The file could not be found." & Chr(13) & "Routine Ending.", vbCritical, "FileOpenRebuildSaveClose")
End
End If
If (swModel.IsOpenedReadOnly = "False") Then
If (swModel.GetType <> swDocDRAWING) Then
'Shade Part
swModel.ViewDisplayShaded
'Set view
'swModel.ShowNamedView2 "*Isometric", 7
'swModel.ShowNamedView2 "*Trimetric", 8
swModel.ShowNamedView2 "*Dimetric", 9
'Set Feature Manager Splitter Position
swModel.FeatureManagerSplitterPosition = 0.3
End If
'Rebuild File
'swModel.EditRebuild3 'Stoplight or [Ctrl]+B
swModel.ForceRebuild '[Ctrl]+Q
'Zoom to extents
swModel.ViewZoomtofit2
'Save
swModel.Save2 False
Else
strResponse = MsgBox("The file is Read-Only." & Chr(13) & "Do you want to close the file without Saving?", vbCritical + vbYesNo, "FileOpenRebuildSaveClose")
End If
Set swModel = Nothing
If (strResponse = vbYes) Then
'Close
swApp.CloseDoc strPathAndFilename
End If
Set swApp = Nothing
End Sub