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