Move Assembly Components to New Folder Example (VBA)
This example shows how to move selected assembly components to a newly
created folder in the FeatureManager design tree.
'-------------------------------------------------------
' Preconditions: Specified assembly document to open exists.
'
' Postconditions:
' 1. Assembly document is opened.
' 2. The valve<1> and valve_guide<1> components
are selected.
' 3. Folder named Folder1 is created in the FeatureManager
design tree.
' 4. The valve<1> and valve_guide<1> components
are moved to Folder1,
' which
you can verify by expanding the Folder1 folder.
'
' NOTE: Because the assembly document is used by an online
' SolidWorks tutorial, do not save any changes when
' closing the document.
'--------------------------------------------------------
Option Explicit
Sub Main()
Dim
swApp As SldWorks.SldWorks
Dim
modelDoc2 As SldWorks.modelDoc2
Dim
assemblyDoc As SldWorks.assemblyDoc
Dim
featureMgr As SldWorks.FeatureManager
Dim
modelDocExt As SldWorks.ModelDocExtension
Dim
selectionMgr As SldWorks.selectionMgr
Dim
feature As SldWorks.feature
Dim
selObj As Object
Dim
errors As Long
Dim
warnings As Long
Dim
status As Boolean
Dim
count As Long
Dim
componentToMove As SldWorks.Component2
Dim
componentsToMove() As Object
Dim
i As Long
Dim
retVal As Boolean
Set
swApp = CreateObject("SldWorks.Application")
'Open
assembly document
swApp.OpenDoc6 "C:\Program Files\SolidWorks
Corp\SolidWorks\samples\tutorial\motionstudies\valve_cam.sldasm",
swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings
Set
modelDoc2 = swApp.ActiveDoc
Set
assemblyDoc = modelDoc2
'Select
and get the two valve-related components to move to the new folder
Set
modelDocExt = modelDoc2.Extension
Set
selectionMgr = modelDoc2.SelectionManager
status
= modelDocExt.SelectByID2("valve-1@valve_cam",
"COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
Set
selObj = selectionMgr.GetSelectedObject6(1,
-1)
status
= modelDocExt.SelectByID2("valve_guide-1@valve_cam",
"COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
Set
selObj = selectionMgr.GetSelectedObject6(2,
-1)
count
= selectionMgr.GetSelectedObjectCount2(0)
ReDim
componentsToMove(count - 1)
For
i = 0 To count - 1
Set
componentToMove = selectionMgr.GetSelectedObjectsComponent3(i
+ 1, 0)
Set
componentsToMove(i) = componentToMove
Next
'Create
the folder where to move the selected components
Set
featureMgr = modelDoc2.FeatureManager
Set
feature = featureMgr.InsertFeatureTreeFolder2(swFeatureTreeFolder_EmptyBefore)
Set
feature = assemblyDoc.FeatureByName("Folder1")
'Move
the selected components to the new folder
retVal
= assemblyDoc.ReorderComponents(componentsToMove,
feature, swReorderComponents_LastInFolder)
End Sub