ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
JGJose García28/12/2021

Hello all. I need some help with the below code. Currently the code sets the cutlist part number as filename-1, filename-2. I would like the part numbers to start at filename-01, filename-02 and so on. Any help would be greatly appreciated. 

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim thisFeat As SldWorks.Feature
Dim thisSubFeat As SldWorks.Feature
Dim custPropMgr As SldWorks.CustomPropertyManager
Dim retValue As Integer
Dim nameS As Variant
Dim cutListFolder As SldWorks.BodyFolder
Dim boolstatus As Boolean
Dim value As String

'PART NUMBER ASSIGNMENT VARIABLES
Dim sExtension As String
Dim retQty As String
Dim retQty1 As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set thisFeat = Application.SldWorks.ActiveDoc.FeatureByName("Solid Bodies")
Set cutListFolder = thisFeat.GetSpecificFeature2
Debug.Print cutListFolder.SetAutomaticCutList(False)
Debug.Print cutListFolder.SetAutomaticCutList(True)
Set swModelExt = swModel.Extension
swModel.ForceRebuild3 (True)

sExtension = 0

If Not cutListFolder Is Nothing And cutListFolder.UpdateCutList Then
Debug.Print "Updated"
 
Set thisSubFeat = thisFeat.GetFirstSubFeature
 
Do While Not thisSubFeat Is Nothing
 
sExtension = sExtension + 1
 
If thisSubFeat.GetTypeName = "CutListFolder" Then Set cutListFolder = thisSubFeat.GetSpecificFeature2
If Not cutListFolder Is Nothing And cutListFolder.GetBodyCount > 0 Then
 
Set custPropMgr = thisSubFeat.CustomPropertyManager
nameS = custPropMgr.GetNames
 
If UBound(Filter(nameS, "QUANTITY")) > -1 Then
boolstatus = custPropMgr.Get4("QUANTITY", True, retQty, retQty1)
boolstatus = InStr(1, retQty)
If boolstatus = False Then
value = custPropMgr.Delete("PART NUMBER")
value = custPropMgr.Add2("PART NUMBER", swCustomInfoText, swModel.GetTitle + "-" + sExtension)
Debug.Print thisSubFeat.Select2(True, 0)
End If
End If
End If
Set thisSubFeat = thisSubFeat.GetNextSubFeature
Loop
End If
 
swModel.ForceRebuild3 (True)

End Sub

​​​​​​​