Lesson 3.2 homework part B solution

Files

Lesson 3.2 homework part B solution

Code

'Homework 3.2b
'This problem is DIFFICULT and can be solved many ways.
'Create a part on your desktop called Part1.SLDPRT. This part needs to contain at least two _
    configurations with the names "a", "b", and so on. Write a macro that saves out each _
    configuration to the desktop. To accomplish this: _
    1. Save the part X times to the desktop with a name like "Part1-configname.SLDPRT", _
        where X is equal to the total number of configurations. Note that you can save _
        yourself a lot of work by using the "save as copy" option when saving. _
    2. Open each newly saved part, deleting out the excess configurations. _
    
Const strFileLocation As String = "C:\Users\Keith\Desktop"
    
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swNewModel As SldWorks.ModelDoc2
Dim strTitle As String
Dim strTitleNoExt As String
Dim vConfigNames As Variant
Dim vNewConfigNames As Variant
Dim i As Integer
Dim j As Integer
Dim lngErrors As Long
Dim lngWarnings As Long
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    'make sure a part document is open
    If swModel Is Nothing Then
        MsgBox "Open a part with multiple configurations."
        End
    End If
    If swModel.GetType <> swDocPART Then
        MsgBox "Open a part with multiple configurations."
        End
    End If
    
    vConfigNames = swModel.GetConfigurationNames
    If UBound(vConfigNames) = 0 Then
        MsgBox "Only one configuration. Macro will end."
        End
    End If
    
    'save out new parts
    strTitleNoExt = Left(swModel.GetTitle, InStrRev(swModel.GetTitle, ".") - 1)
    For i = 0 To UBound(vConfigNames)
        'the following code assigns the appropriate name for the newly saved file _
            regardless of whether the original file was originally saved and whether _
            the user has "Hide file extensions" turned on in their Windows folder options
        strTitle = UCase(swModel.GetTitle)
        If InStr(1, strTitle, ".SLDPRT") = 0 Then
            strTitle = strTitleNoExt & "-" & vConfigNames(i) & ".SLDPRT"
        Else
            strTitle = Replace(strTitle, ".SLDPRT", "")
            strTitle = strTitleNoExt & "-" & vConfigNames(i) & ".SLDPRT"
        End If
        swModel.Extension.SaveAs strFileLocation & strTitle, 0, 2, Nothing, lngErrors, lngWarnings
        
        'open new part with appropriate config already active
        Set swNewModel = swApp.OpenDoc6(strFileLocation & strTitle, 1, 0, vConfigNames(i), lngErrors, lngWarnings)
        
        'delete out excess configs
        vNewConfigNames = swNewModel.GetConfigurationNames
        For j = 0 To UBound(vNewConfigNames)
            If vNewConfigNames(j) <> vConfigNames(i) Then
                swNewModel.DeleteConfiguration2 vNewConfigNames(j)
            End If
        Next j
        
        'save changes
        swNewModel.Save3 0, lngErrors, lngWarnings
        
        'close new part
        swApp.CloseDoc strTitle
    Next i
End Sub