Abilash V.

To save SolidWorks Toolbox Components as Part Files Without Flag

Discussion created by Abilash V. on Aug 29, 2017
Latest reply on Aug 30, 2017 by 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

Outcomes