ShowOnly Macro if Interested

[brengine]

Credit for writing the macro goes to the author Chen, but I don't have any other info. (links) regarding where I got this.


' ******************************************************************************
' c:\temp\swx1836\Macro1.swb - macro recorded on 07/04/02 by chen
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Global selected(1000) As Variant

Sub TraverseAssyArray(ByVal ComponentIn As Object)

Dim Component, modelDoc As Object
Dim componentName As String
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Dim isRootComponent As Boolean
Dim visible As Long
Dim doc As Object

Set swApp = CreateObject("SldWorks.Application&quot
Set model = swApp.ActiveDoc ' Current document
Set Component = ComponentIn ' Accept the component passed in
Set SelMgr = model.SelectionManager

If Component Is Nothing Then ' If no component, then exit
Exit Sub
End If

componentName = Component.Name ' Get the component name
Children = Component.GetChildren ' Get the list of children (if any)

If (IsEmpty(Children)) Then ' If array contains no children, then recurse out
Exit Sub
End If

ChildCount = UBound(Children) + 1
If (ChildCount > 0) Then


j = 0
For i = 0 To (ChildCount - 1) ' For each Child in this subassembly, get its children
Set Child = Children(i) ' Get component from array of children
If Not (Child.IsSuppressed) Then
If Child.GetModelDoc.gettype = 1 Then
partselected = False
For q = 1 To 1000
If Child.Name = selected(q) Then
partselected = True
End If
Next
If partselected Then
retval = Child.deSelect()
Else
retval = Child.select(True)
End If
p = p + 1
Else
TraverseAssyArray Child ' Recurse In and traverse this child component
End If
End If
Next i

Level = Level - 1 ' Adjust level as we come out of recursion

End If
End Sub
Sub main()

Dim swApp As Object
Dim doc As Object
Dim RootComponent, Configuration As Object
Dim SelMgr As Object

Set swApp = CreateObject("SldWorks.Application&quot
Set doc = swApp.ActiveDoc ' Current document

For i = 1 To 1000
selected(i) = ""
Next

If doc Is Nothing Then
MsgBox "No document was opened"
Exit Sub
ElseIf doc.gettype = 1 Or doc.gettype = 3 Then
MsgBox "Toggle Selection applies only to assemblies"
Exit Sub
End If

Set SelMgr = doc.SelectionManager
For i = 1 To 1000
Set curcomp = SelMgr.GetSelectedObject3(i)
selType = SelMgr.GetSelectedObjectType2(i) ' Check the selected object type
If selType = 2 Or selType = 1 Or selType = 3 Then
Set curcomp = curcomp.GetComponent
curcomp.select (True)
selected(i) = curcomp.Name
End If
Next
For i = 1 To 1000
Set curcomp = SelMgr.GetSelectedObject3(i)
selType = SelMgr.GetSelectedObjectType2(i) ' Check the selected object type
If selType = 20 Then ' If item is face, edge or vertex
selected(i) = curcomp.Name ' Get the owning Component object
End If
Next
Set Configuration = doc.GetActiveConfiguration()
Set RootComponent = Configuration.GetRootComponent()

doc.ResolveAllLightWeightComponents True

If Not RootComponent Is Nothing Then
doc.clearselection
TraverseAssyfaces RootComponent
End If
For i = 1 To 1000
selected(i) = ""
Next

For j = 1 To 1000
Set curcomp = SelMgr.GetSelectedObject3(j)
selType = SelMgr.GetSelectedObjectType2(j) ' Check the selected object type
If selType = 20 Then ' If item is face, edge or vertex
selected(j) = curcomp.Name ' Get the owning Component object
ElseIf selType = 2 Then 'Or selType = 1 Or selType = 3
Set curcomp = curcomp.GetComponent
selected(j) = curcomp.Name
End If
Next j

Set Configuration = doc.GetActiveConfiguration()
Set RootComponent = Configuration.GetRootComponent()

doc.ResolveAllLightWeightComponents True

If Not RootComponent Is Nothing Then
TraverseAssyArray RootComponent
End If
doc.HideComponent2

End Sub
Sub TraverseAssyfaces(ByVal ComponentIn As Object)

Dim Component, modelDoc As Object
Dim componentName As String
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Dim isRootComponent As Boolean
Dim visible As Long
Dim doc As Object

Set swApp = CreateObject("SldWorks.Application&quot
Set model = swApp.ActiveDoc ' Current document
Set Component = ComponentIn ' Accept the component passed in
Set SelMgr = model.SelectionManager
'model.clearselection

If Component Is Nothing Then ' If no component, then exit
Exit Sub
End If

componentName = Component.Name ' Get the component name
Children = Component.GetChildren ' Get the list of children (if any)

If (IsEmpty(Children)) Then ' If array contains no children, then recurse out
Exit Sub
End If

ChildCount = UBound(Children) + 1
If (ChildCount > 0) Then


j = 0
For i = 0 To (ChildCount - 1) ' For each Child in this subassembly, get its children
Set Child = Children(i) ' Get component from array of children
If Not (Child.IsSuppressed) Then
If Child.GetModelDoc.gettype = 1 Then
partselected = False
For q = 1 To 1000
If Child.Name = selected(q) Then
partselected = True
End If
Next
If partselected Then
retval = Child.select(True)
End If
Else
TraverseAssyfaces Child ' Recurse In and traverse this child component
End If
End If
Next i

Level = Level - 1 ' Adjust level as we come out of recursion

End If
End Sub

 

[SBaugh]

You should post this in the FAQ. Scott Baugh, CSWP
credence69@REMOVEhotmail.com

http://www.3dmca.com

http://home.insightbb.com/~scott.baugh/

*When in doubt always check the help*