9 Replies Latest reply on Nov 14, 2016 7:14 AM by John Stoltzfus

    Macro for ripping just top level parent configs

    Rob Edwards

      I was wondering if anyone is aware of a macro (or workflow) that could rip a part into its separate configs but leave derived configs as configs of the new parts?

      This has all stemmed from my inability to reverse a sketch offset in 2015... Think its defo time I upgraded


        • Re: Macro for ripping just top level parent configs
          Deepak Gupta

          There is no macro but I think it can be made.


          But here is manual steps you can use.


          1. Activate/select the derived config.
          2. Press Ctrl+C (copy). You can also do Ctrl+X (cut) and click yes on the prompt for confirmation to delete.
          3. Select the model name in tree (top of tree)
          4. Press Ctrl+V (paste).
          5. Delete derived config (no need if used the cut option) and rename the copied config (created in step 4).
            • Re: Macro for ripping just top level parent configs
              Rob Edwards

              Thankyou Deepak

              I managed to remove my derived configurations by using a custom property and some global vars so I've dodged the issue this time, but I'm looking forward to learning how to use macros.  I tried out #TASK that you shared the other week and it's brilliant,, I can't wait to start.

              However I'm still messing about learning cutlists and BOM's and custom properties.


              I will do as you suggest, but I think what I was hoping for is more complicated.  Similar to the Configuration Splitter available in #TASK.

              As I say I don't need it now but say I have 38 configurations of my part.  Each config has 2 derived configs

              If I run the Config Splitter on this part I get 114 parts.  I would like to get just the 38, each with two configs.



              filename_1 <a>/<b>

              filename_2 <a>/<b>

              filename_3 <a>/<b>











              Thanks again

            • Re: Macro for ripping just top level parent configs
              Ivana Kolin
              Option Explicit
              Const destFolder = "H:\temp"
              Dim swApp                                         As SldWorks.SldWorks
              Dim swModel                                       As SldWorks.ModelDoc2
              Dim swNewModel                                    As SldWorks.ModelDoc2
              Dim boolstatus                                    As Boolean
              Dim errors                                        As Long
              Dim warnings                                      As Long
              Sub main()
                  Dim swConfig                                  As SldWorks.Configuration
                  Dim FolderPath                                As String
                  Dim FileName                                  As String
                  Dim ExtensionName                             As String
                  Dim ActiveConfigName                          As Variant
                  Dim ActiveConfigCleanName                     As String
                  Dim vConfigNameArr                            As Variant
                  Dim strDestinationFolder                      As String
                  Dim ConfigName                                As Variant
                  On Error GoTo main_Error
                  Set swApp = Application.SldWorks
                  Set swModel = swApp.ActiveDoc
                  If (swModel Is Nothing) Then
                      Err.Raise vbObjectError + 1, "", "Open assembly or part"
                  ElseIf (swModel.GetType <> SwConst.swDocumentTypes_e.swDocPART And swModel.GetType <> SwConst.swDocumentTypes_e.swDocASSEMBLY) Then
                      Err.Raise vbObjectError + 2, "", "Open assembly or part"
                  End If
                  vConfigNameArr = swModel.GetConfigurationNames
                  If IsEmpty(vConfigNameArr) Then Err.Raise vbObjectError + 5, "", "No configurations"
                  If UBound(vConfigNameArr) = 0 Then Err.Raise vbObjectError + 6, "", "One configuration"
                  If destFolder = "" Then
                      strDestinationFolder = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
                      strDestinationFolder = destFolder
                  End If
                  FolderPath = AddBackSlashToPath(strDestinationFolder)
                  CreateDirectory FolderPath
                  ExtensionName = Split(swModel.GetPathName, ".")(UBound(Split(swModel.GetPathName, ".")))
                  For Each ActiveConfigName In vConfigNameArr
                      Set swConfig = swModel.GetConfigurationByName(ActiveConfigName)
                      If swConfig.IsDerived = False Then
                          ActiveConfigCleanName = CleanName(CStr(ActiveConfigName))
                          FileName = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1)
                          FileName = Mid(FileName, InStrRev(FileName, "\") + 1) & "_" & ActiveConfigCleanName & "." & ExtensionName
                          If (swModel.Extension.SaveAs(FolderPath & FileName, 0, swSaveAsOptions_e.swSaveAsOptions_Copy + swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave + swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)) Then
                              Set swNewModel = swApp.OpenDoc6(FolderPath & FileName, swModel.GetType, swOpenDocOptions_e.swOpenDocOptions_LoadModel, ActiveConfigName, errors, warnings)
                              If Not swNewModel Is Nothing Then
                                  For Each ConfigName In vConfigNameArr
                                      If (UBound(vConfigNameArr) < 1) Then
                                          Exit For
                                      End If
                                      Set swConfig = swNewModel.GetConfigurationByName(ConfigName)
                                      If Not swConfig Is Nothing Then
                                          If swConfig.IsDerived = False And ActiveConfigName <> ConfigName Then
                                              boolstatus = swNewModel.DeleteConfiguration2(ConfigName)
                                          End If
                                      End If
                                  Next ConfigName
                                  boolstatus = swNewModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent + swSaveAsOptions_e.swSaveAsOptions_AvoidRebuildOnSave, errors, warnings)
                                  swApp.CloseDoc swNewModel.GetPathName
                                  Err.Raise vbObjectError + 3, "", "Could not open file:" & FolderPath & FileName
                              End If
                              Err.Raise vbObjectError + 4, "", "Could not save file" & FolderPath & FileName
                          End If
                      End If
                  Next ActiveConfigName
                  On Error GoTo 0
                  Exit Sub
                  Call showError("Error " & Err.Number & " (" & Err.Description & ") in procedure main of macro SplitCOnfigs")
                  GoTo main_Exit
              End Sub
              Private Sub showError(message As String)
                  MsgBox message
              End Sub
              Function CleanName(sFileName As String) As String
                  Const sInvalidChars                           As String = "/\|<>:*?"""
                  Dim lCt                                       As Long
                  CleanName = sFileName
                  For lCt = 1 To Len(sInvalidChars)
                      CleanName = Replace(CleanName, Mid(sInvalidChars, lCt, 1), "")
                  Next lCt
              End Function
              Private Function AddBackSlashToPath(swPath As String) As String
                  On Error Resume Next
                  If Not swPath = "" Then
                      If Not Right(swPath, 1) = "\" Then
                          swPath = swPath & "\"
                      End If
                  End If
                  AddBackSlashToPath = swPath
              End Function
              Private Sub CreateDirectory(path As String)
                  On Error Resume Next
                  Dim start                                     As Integer
                  Dim dirs                                      As Variant
                  Dim curDir                                    As String
                  Dim i                                         As Integer
                  If path <> "" Then
                      dirs = Split(path, "\")
                      If Left(path, 2) = "\\" Then
                          start = 3
                          start = 1
                      End If
                      curDir = Left(path, InStr(start, path, "\"))
                      For i = start To UBound(dirs)
                          curDir = curDir & dirs(i) & "\"
                          If Dir(curDir, vbDirectory) = vbNullString Then
                              MkDir curDir
                          End If
                      Next i
                  End If
              End Sub