I'm making VBAs to clean the feature tree and automate some process in the way to lighten the work on big welded structures. Every weldment and sheetmetal features in my cutListFolder have a property called 'DESIGNATION', and I'd like to change the feature name to be the same String as its designation.
But right now, I can't get it to work on all of the features. Some of them got renamed just right, but others got renamed with the designation of another feature, or didn't get renamed at all.
Using Debug.Print
, and running the code multiple times, I can see that the I manage to retrieve the designation, but the swFeat.Name = design
line don't seems to take effect
Does any one have an idea on what might be wrong?
Const PRP_DESIGN As String = "DESIGNATION"
Dim swApp As Object
Sub main()
try_:
On Error GoTo catch_
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
Dim swModelExt As SldWorks.ModelDocExtension
Set swModelExt = swModel.Extension
Dim customPropManager As SldWorks.CustomPropertyManager
If Not swModel Is Nothing Then
If swModel.GetType() = swDocumentTypes_e.swDocPART Then
Debug.Print "Start Macro Renaming"
Debug.Print ""
Dim vCutLists As Variant
vCutLists = GetCutLists(swModel)
If UBound(vCutLists) <> -1 Then
Dim swFeat As SldWorks.Feature
Dim i As Integer
For i = 0 To UBound(vCutLists)
Set swFeat = vCutLists(i)
Set customPropManager = swFeat.CustomPropertyManager
Dim design As String
Dim wasResolved As Boolean
customPropManager.Get5 PRP_DESIGN, True, "", design, wasResolved
If Not wasResolved Or design = "" Then
design = "Designation unavailable"
End If
Debug.Print " Renaming " & swFeat.Name & " in " & design
swFeat.Name = design
Next
End If
Debug.Print "Pièces renommées"
Debug.Print ""
Debug.Print "End of Macro Renaming"
Debug.Print ""
Debug.Print ""
Else
Err.Raise vbError, "", "Only part document is supported"
End If
Else
Err.Raise vbError, "", "Open part document"
End If
GoTo finally_
catch_:
MsgBox Err.Description, vbCritical
finally_:
End Sub
Expanding on my comment: a sketch, folder, cut list item etc... are all features, so if any of those have the same name as the the target name (even if they are of a different type) it won't rename. You can check by trying to manually rename it.
if that work you can try to first select the feature before renaming, by replacing: 'swFeat.Name = design', with:
swModel.ClearSelection2 True
swModel.Extension.SelectByID2 swFeat.Name, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0
' or: swFeat.Select2 False, -1
If swModel.SelectionManager.GetSelectedObject6(1, -1) Is Nothing Then
Debug.Print "Can not select feature"
Else
swModel.SelectionManager.GetSelectedObject6(1, -1).Name = design
End If
or send me a test file where that doesn't work, and I'll look into it