I have not solved problem with this macro.

It will take forever to update all drawings one by one when you have a collection of 500 shares in. Are there other options to update the drawings faster. I think a macro will help.

When you print the drawings through EPDM viewer has not been updated to output a few old drawings.

I have SW 2010th.

Macro Zoom and Rebuild does´t work. I have not experience with macro structure. Is there anyone who can do it?

Who can fix this macro?

Help!!!!

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swFilename As String
Dim STIME As Long
Dim ETIME As Long
Dim nErrors As Long
Dim nWarnings As Long
Dim swModelTemp As Long
Dim retval As Long

Dim Response As String
Dim DocName As String

Sub main()

Set swApp = Application.SldWorks

ZoomAndSave "C:\Test\", ".SLDPRT", True
ZoomAndSave "C:\Test\", ".SLDASM", True
ZoomAndSave "C:\Test\", ".SLDDRW", True

End Sub

Sub SuperRebuild()

swModel.SetAddToDB True
swModel.SetDisplayWhenAdded (False)

swApp.SetUserPreferenceToggle swPerformanceVerifyOnRebuild, True

STIME = Timer
'retval = Part.ForceRebuild3(False)  ' Use to force rebuild on all levels of an assembly
retval = swModel.ForceRebuild3(True)  ' Use to force rebuild on only top level of an assembly
ETIME = Timer

swApp.SetUserPreferenceToggle swPerformanceVerifyOnRebuild, False

swModel.SetAddToDB False
swModel.SetDisplayWhenAdded (True)
MsgBox Format(ETIME - STIME, "0.000") & " seconds", vbOKOnly, "SUPER REBUILD"

End Sub

Sub ZoomAndSave(folder As String, ext As String, silent As Boolean)

Dim swDocTypeLong As Long

ext = UCase\$(ext)
swDocTypeLong = Switch(ext = ".SLDPRT", swDocPART, ext = ".SLDDRW", swDocDRAWING, ext = ".SLDASM", swDocASSEMBLY, True, -1)

'If not a SW file, return
If swDocTypeLong = -1 Then
Exit Sub
End If

ChDir (folder)

Response = Dir(folder)
Do Until Response = ""

swFilename = folder & Response

If Right(UCase\$(Response), 7) = ext Then
 
  Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
 
  If swDocTypeLong <> swDocDRAWING Then
    swModel.ShowNamedView2 "*Isometric", -1
  End If
 
  swModel.ViewZoomtofit2
  swModel.ForceRebuild3 False
 
  SuperRebuild

  swModel.Save2 silent
  swApp.CloseDoc swModel.GetTitle
 
End If

Response = Dir
Loop

End Sub

Excuse for bad English.