'Many thanks to Ronnie for his helpful input
'Here is a macro for changing the view to iso and then a zoom that replicates a user zoom. 'This works on a directory level and gets each part document in turn.
'Easy to change for assembly and drawing document by changing the following. 'Const swDocType = ".SLDPRT" 'Dim swModel As SldWorks.PartDoc
'remove 'swModel.ShowNamedView2 "*Isometric", -1 'for drawings
'questions I still have ' if there are constants, how can this be changed in the macro? 'Also is there a way of having a user input box for directory and file types and closing Solidworks down ' after the 'macro has run?
Dim Part As Object Dim SelMgr As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim Feature As Object Option Explicit
Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.PartDoc Dim ReturnVal As Long Dim Response As String Dim DocName As String Dim Success As Boolean Dim DocType As String Dim swUpper As String Dim swDocTypeLong As Long
' ' ' ' ' Const workDir = "C:\A Solidworks WD\Waddington\" ' HERE YOU CHANGE THE DIRECTORY THAT YOU WANT TO UPDATE, remember the back slash at the end. ' ' ' ' ' ' ' Const swDocType = ".SLDPRT"
Const readOnly = 0 ' 0-false 1-true Const viewOnly = 0 ' 0-false 1-true Const silent = 1 ' 0-false 1-true
' start of main program Sub main()
Set swApp = Application.SldWorks swApp.Visible = True ChDir (workDir) Response = Dir(workDir) Do Until Response = ""
Dim swName As String swName = workDir & Response
swUpper = UCase$(Response) If Right(swUpper, 7) = swDocType Then
If UCase$(swDocType) = ".SLDPRT" Then swDocTypeLong = swDocPART Else Stop 'Error Occured End If
Dim nErrors As Long Dim nWarnings As Long
Set swModel = swApp.OpenDoc6(swName, swDocTypeLong, swOpenDocOptions_e.swOpenDocOptions_Silent, "", nErrors, nWarnings)
swModel.ShowNamedView2 "*Isometric", -1
swModel.ViewZoomtofit2
swModel.ForceRebuild3 False
DocName = swModel.GetTitle ReturnVal = swModel.Save2(silent)
swApp.CloseDoc DocName Set swModel = Nothing
End If
' get the next filename
Response = Dir
Loop
Set swApp = Nothing
End Sub