Macro for iso view and zoom

'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