×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

ShowOnly Macro if Interested

ShowOnly Macro if Interested

ShowOnly Macro if Interested

(OP)
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")
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")
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")
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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources