3 Replies Latest reply on Aug 30, 2017 11:16 AM by Abilash V.

    To save SolidWorks Toolbox Components as Part Files Without Flag

    Abilash V.

      Procedure:

      1.This helps to save the Toolbox components in Active Assembly to a location as per user input and to remove the Toolbox Flag.

      2. Rebuild and save the Assembly for seeing the changes .

       

      Dim swApp As SldWorks.SldWorks

      Dim swmodel As SldWorks.ModelDoc2

      Dim swassem As SldWorks.AssemblyDoc

      Dim vcomp As Variant

      Dim swcomp As SldWorks.Component2

      Dim swpart As SldWorks.ModelDoc2

      Dim a As Integer

      Dim bool As Boolean

      Dim err As Long

      Dim war As Long

      Dim asname As String

      Dim pname As String

      Dim floc As String

      Sub main()

      Set swApp = Application.SldWorks

      Set swmodel = swApp.ActiveDoc

      Set swassem = swmodel

      floc = InputBox("enter the location")

      asname = swmodel.GetTitle

      vcomp = swassem.GetComponents(True)

      For i = 0 To UBound(vcomp)

      Set swcomp = vcomp(i)

      Set swpart = swcomp.GetModelDoc2

      If swpart Is Nothing Then

      Else

      'MsgBox swpart.GetTitle

      pname = swpart.GetTitle

      a = swpart.Extension.ToolboxPartType

      If a = 1 Then

      'MsgBox ("toolbox component")

      swApp.ActivateDoc3 pname, False, 1, err

      bool = swpart.Extension.SaveAs(floc & "\" & swpart.GetTitle & i & ".sldprt", 0, 1, Nothing, err, war)

      swpart.Extension.ToolboxPartType = 0

      'MsgBox (swpart.Extension.ToolboxPartType)

      bool = swpart.Save3(1, err, war)

      'MsgBox bool

      swApp.ActivateDoc3 asname, True, 1, err

      ElseIf a = 2 Then

      'MsgBox ("toolbox component")

      swApp.ActivateDoc3 pname, False, 1, err

      bool = swpart.Extension.SaveAs(floc & "\" & swpart.GetTitle & i & ".sldprt", 0, 1, Nothing, err, war)

      swpart.Extension.ToolboxPartType = 0

      'MsgBox (swpart.Extension.ToolboxPartType)

      bool = swpart.Save3(1, err, war)

      'MsgBox bool

      swApp.ActivateDoc3 asname, True, 1, err

      End If

      End If

      Next

      swmodel.ForceRebuild3 False

      bool = swmodel.Save3(1, err, war)

      swmodel.ForceRebuild3 False

      End Sub

       

      Regards

      Abilash