Hey all,

I'm very new to the macro world, but I'm trying to learn and was looking for a little help.  I've cobbled together a macro (mostly stuff posted here by that can rename Weldment cutlist items using "Filename-ConfiurationName-Counter".  Everything works well except the Configuration part.  The macro renames cutlist items in all configurations using whichever configuration is currently selected.  What I would like is a macro that runs on all configurations, but renames using each cutlist's specific configuration.  Here's my code...can you help, please?

Option Explicit

Dim SwApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swConfig As SldWorks.ModelDoc2

Dim sModelName As String

Dim sConfigName As String

Dim Part As SldWorks.ModelDoc2

Dim swFeat As SldWorks.Feature

Dim boolstatus As Long

Dim foldercount As Integer

Dim prefixName As String

Sub Main()

'prefixName = InputBox("Enter a prefix for the cut-list folder names")

foldercount = 0

Set SwApp = CreateObject("SldWorks.Application")

Set Part = SwApp.ActiveDoc

Set swModel = SwApp.ActiveDoc

Set swConfig = SwApp.ActiveDoc

'File name with extension

sModelName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

Debug.Print sModelName

'File name without extension

sModelName = Left(sModelName, InStrRev(sModelName, ".") - 1)

Debug.Print sModelName

'Read Configuration name and write it to variable string

sConfigName = swModel.GetActiveConfiguration.Name

Debug.Print sConfigName

'Label1.Text = String1.Substring(0, 5) & "-" & String1.Substring(5)

prefixName = sModelName & "-" & sConfigName & "-"

If Part Is Nothing Then

MsgBox ("A part must be opened")

Exit Sub

End If

If Part.GetType <> 1 Then

MsgBox ("A part must be opened")

Exit Sub

End If

Set swFeat = Part.FirstFeature

TraverseFeatures swFeat, True

Part.ClearSelection2 (True)

End Sub

Sub TraverseFeatures(ByVal thisFeat As Feature, ByVal isTopLevel As Boolean)

Dim curFeat As SldWorks.Feature

Set curFeat = thisFeat

While Not curFeat Is Nothing

If Not isTopLevel Then DoTheWork curFeat

Dim subfeat As SldWorks.Feature

Set subfeat = curFeat.GetFirstSubFeature

While Not subfeat Is Nothing

TraverseFeatures subfeat, False

Dim nextSubFeat As SldWorks.Feature

Set nextSubFeat = subfeat.GetNextSubFeature

Set subfeat = nextSubFeat

Set nextSubFeat = Nothing

Wend

Set subfeat = Nothing

Dim nextFeat As SldWorks.Feature

If isTopLevel Then

Set nextFeat = curFeat.GetNextFeature

Else

Set nextFeat = Nothing

End If

Set curFeat = nextFeat

Set nextFeat = Nothing

Wend

End Sub

Sub DoTheWork(ByVal thisFeat As Feature)

If thisFeat.GetTypeName = "CutListFolder" Then

If thisFeat.GetSpecificFeature2.GetBodyCount = 0 Then Exit Sub

foldercount = foldercount + 1

boolstatus = Part.Extension.SelectByID2(thisFeat.Name, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)

Part.SelectionManager.GetSelectedObject5(1).Name = prefixName & IIf(foldercount < 10, "00" + CStr(foldercount), IIf(foldercount < 100, "0" + CStr(foldercount), CStr(foldercount)))

End If

End Sub