×
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

Dissolving Multiple Sub-Assemblies

Dissolving Multiple Sub-Assemblies

Dissolving Multiple Sub-Assemblies

(OP)
thread559-241981: Dissolving Multiple Sub-Assemblies???

I came across a thread today and found the suggested answer needed a bit of tweaking. User "handleman" delivered the goods and I am extremely happy I found it. I use Solidworks and and Altium designer. Every time we wanted to performa fit check on the circuits with our assemblies, it would produce the .stp files from Altium with sub assemblies full of sub assemblies of parts.

I found that the code worked, but would never fully dissolve a sub assembly, leaving it at one level. I changed the "If UBound(swComp.GetChildren) > 0 Then" to "-1" and it took it all out for me.

Hope this is useful to you as it was for me!


CODE --> VBA

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim myCompCollection As New Collection
Dim Info As String
Dim i As Long

Sub main()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
If swDoc.GetType <> swDocASSEMBLY Then
    MsgBox "This macro only works in assemblies."
    Exit Sub
End If
Set swAssy = swDoc
Set swSelMgr = swDoc.SelectionManager
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
    If swSelMgr.GetSelectedObjectType3(i, -1) = swSelCOMPONENTS Then
        Set swComp = swSelMgr.GetSelectedObject6(i, -1)
        If UBound(swComp.GetChildren) > -1 Then
            myCompCollection.Add swComp
        End If
    End If
Next i

swDoc.ClearSelection2 True
Info = ""
For i = 1 To myCompCollection.Count
    Set swComp = myCompCollection(i)
    swComp.Select4 False, Nothing, False
    Info = Info & "Successfully Dissolved " & swComp.Name2 & ": " & swAssy.DissolveSubAssembly & vbCrLf
Next i
    
Set myCompCollection = Nothing
If Info = "" Then Info = "No subassemblies were selected"
MsgBox "Subassembly dissolve results: " & vbCrLf & vbCrLf & Info
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