1 Reply Latest reply on Aug 10, 2018 2:13 PM by Deepak Gupta

    drawing document will not save after macro

    Robert Caste

      This opens a drawing file in my template, puts views on second page, activates the first page again and exits, but will not save in the output folder as specified by the open assembly model. I’ve tried setting to dirty and running in #task and still no luck. I’ve also tried using actual parameters for the save method and recording a save macro on the drawing document, then running that macro with the drawing and it still didn’t save.

       

       

      Option Explicit

       

      Dim Part As Object

      Dim vConfs As Variant

      Dim i As Integer

       

       

       

      Const sDrTemplate As String = "\\zserver\Sharepoint\Hamel\templates\Zephyr\ZEP B-FAB APUCOLUMNWELD.drwdot"

       

       

      Dim longstatus As String

      Dim longwarnings As Long

      Dim vSheetName, vModelName

      Dim sOutputFolder As String

      Dim swApp As SldWorks.SldWorks

      Dim swModel As SldWorks.ModelDoc2

      Dim swSelMgr As SldWorks.SelectionMgr

      Dim swFeatMgr As SldWorks.FeatureManager

      Dim swView As SldWorks.View

      Dim swBomAnn As BomTableAnnotation

      Dim swBomFeat As SldWorks.BomFeature

      Dim AnchorType As Long

      Dim BomType As Long

      Dim Configuration As String

      Dim TableTemplate As String

      Dim Names As Variant

      Dim Visible As Variant

      Dim boolstatus As Boolean

      Dim swDraw As SldWorks.DrawingDoc

      Dim swSheet As SldWorks.Sheet

       

       

       

       

      Sub Main()

      Set swApp = Application.SldWorks

        

          Set swModel = swApp.ActiveDoc

        

          sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - Len(swModel.GetTitle()))

         

      ' New Document

      Dim swSheetWidth As Double

      swSheetWidth = 0.4318

      Dim swSheetHeight As Double

      swSheetHeight = 0.2794

      Set swDraw = swApp.NewDocument(sDrTemplate, 0, 0, 0)

      Dim swDrawing As DrawingDoc

       

      Dim swDrawModel As SldWorks.ModelDoc2

      Set swDrawModel = swDraw

      swDraw.InsertModelInPredefinedView swModel.GetPathName()

       

       

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          Set swSelMgr = swModel.SelectionManager

          Set swFeatMgr = swModel.FeatureManager

         

          Set swDraw = swDraw

          Set swSheet = swDraw.GetCurrentSheet

         

         

       

       

        'Visit each sheet

        vSheetName = swDraw.GetSheetNames

        For i = 0 To UBound(vSheetName)

          'Activate and access

          swDraw.ActivateSheet vSheetName(i)

          Set swSheet = swDraw.Sheet(vSheetName(i))

          If swSheet.IsLoaded Then

            'Okay

          Else

            If MsgBox(vSheetName(i) & " is not loaded.", vbOKCancel + vbDefaultButton2) = vbCancel Then Exit Sub

          End If

       

          'Visit all views

          Set swView = swDraw.GetFirstView

          While Not swView Is Nothing

            'Debug.Print "    " & swView.GetName2 & " [" & swView.Type & "]"

            Select Case swView.Type

              Case swDrawingViewTypes_e.swDrawingNamedView

                If IsEmpty(vModelName) Then

                  'Get the model loaded in this view

                  vModelName = swView.GetReferencedModelName

                Else

                  'Set the model in this view

                  swDraw.InsertModelInPredefinedView vModelName

                End If

                'Make the sketches visible

                'swView.ResetSketchVisibility

            End Select

            Set swView = swView.GetNextView

          Wend

          'swModel.swSaveAsOptions_Silent , Empty, Empty

        Next

        'Back to first view

        swDraw.ActivateSheet vSheetName(0)

        'Force a rebuild!

       

       

      swModel.EditRebuild3

       

          swModel.Save3 swSaveAsOptions_Silent, Empty, Empty

       

          swApp.QuitDoc swModel.GetTitle

      End sub