8 Replies Latest reply on Mar 1, 2018 1:40 AM by Senad Muhovic

    Macro - drawing update & save

    Senad Muhovic


      After I have approved an assembly, I want that all drawings of partners and sub-assembly is automatically updated and saved again.


      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?


      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.ForceRebuild3 False

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

      Response = Dir

      End Sub



      Excuse for bad English.