1 Reply Latest reply on Oct 27, 2015 1:35 PM by Elmar Klammer

    API Excel In Solidworks Macro

    Paul Johnson

      I have and enclosure model that is driven by one central excel file.  The design tables which are part of the .sldprt or .sldasm are linked to this excel file.  I found this macro below which automates the open design table and close updating the .sldprt or sldasm files.  I lost the link so I can't give proper credit.  This works well, but when I duplicate the base files and want to point the links to a new central excel file I have to manually change the source files.

       

      I haven't programmed in many years and am not grasping the VB.  I would like to modify this code to ask for the new excel file location, provide a way to terminate the program before proceeding and then open the excel file, change the linked pointer and update excel and close excel for each file with a design table.

       

      Excel Macro:

       

      Sub Macro2()

      '

      ' Macro2 Macro

      '

       

       

      '

          ChDir "C:\LV Vault\NB\NBP000083_WallMount_HeatsinkExternal\Option2"

          ActiveWorkbook.ChangeLink Name:="HeatSinkExtWallMount_t.xlsx", NewName:= _

              "C:\LV Vault\NB\NBP000083_WallMount_HeatsinkExternal\Option2\HeatSinkExtWallMount_2.xlsx" _

              , Type:=xlExcelLinks

      End Sub

       

       

      Working Solidworks macro that opens each solidworks file in an assembly that has a design table and updates the design table links.

       

       

       

      Sub DesTblUpdate()

      Dim swDoc As SldWorks.ModelDoc2

      Dim swDocXt As SldWorks.ModelDocExtension

      Dim DesTbl As SldWorks.DesignTable

      Dim swAllDocs As EnumDocuments2

      Dim FirstDoc As SldWorks.ModelDoc2

      Dim dummy As Boolean

      Dim NumDocsReturned As Long

      Dim DocCount As Long

      Dim DesTblCount As Long

      Dim i As Long

      Dim DoTheUpdate As Long

      Dim sMsg As String

      Dim swApp As SldWorks.SldWorks

      Dim bDocWasVisible As Boolean

       

       

      Set swApp = Application.SldWorks

      Set swAllDocs = swApp.EnumDocuments2

      Set FirstDoc = swApp.ActiveDoc

       

       

      DocCount = 0

      DesTblCount = 0

       

       

      swAllDocs.Next 1, swDoc, NumDocsReturned

       

       

      While NumDocsReturned <> 0

          Set swDocXt = swDoc.Extension

          If swDocXt.HasDesignTable Then

              DesTblCount = DesTblCount + 1

          End If

       

       

          swAllDocs.Next 1, swDoc, NumDocsReturned

          DocCount = DocCount + 1

       

       

      Wend

       

       

      sMsg = DocCount & " Documents, " & DesTblCount & " of which had design tables"

      sMsg = sMsg & vbCrLf & vbCrLf & "Do you want to update all these tables?"

      DoTheUpdate = MsgBox(sMsg, vbYesNo, "Update Design Tables?")

      If DoTheUpdate = vbNo Then

          Exit Sub

      End If

       

       

      DocCount = 0

      DesTblCount = 0

      swAllDocs.Reset

      swAllDocs.Next 1, swDoc, NumDocsReturned

      While NumDocsReturned <> 0

          Set swDocXt = swDoc.Extension

          If swDocXt.HasDesignTable Then

              DesTblCount = DesTblCount + 1

              bDocWasVisible = swDoc.Visible

              swApp.ActivateDoc swDoc.GetPathName

              Set DesTbl = swDoc.GetDesignTable

              dummy = DesTbl.Attach

              dummy = DesTbl.UpdateTable(swDesignTableUpdateOptions_e.swUpdateDesignTableAll, True)

              DesTbl.Detach

              swDoc.Visible = bDocWasVisible

          End If

          swAllDocs.Next 1, swDoc, NumDocsReturned

          DocCount = DocCount + 1

      Wend

       

       

      swApp.ActivateDoc FirstDoc.GetPathName

      End Sub

       

       

       

      Thank you,

        • Re: API Excel In Solidworks Macro
          Elmar Klammer

          Sub insert()

          Dim swModel         As SldWorks.ModelDoc2

          Dim swDesignTable   As SldWorks.DesignTable

          Dim Longstatus   As Long

          Dim Longwarnings As Long

           

          Set swapp = CreateObject("SldWorks.Application")

           

           

          FileName = "c:\dt.xls"
                
                 
                 
          Set swModel = swapp.ActiveDoc
                
                  swModel.DeleteDesignTable
                 
                  swModel.InsertFamilyTableOpen (FileName)
                  swModel.CloseFamilyTable
                 
                  Set DesignTable = swModel.GetDesignTable
                 
                  DesignTable.LinkToFile = True
                 
               
                 swModel.Save

          End Sub