Change the case of a property

sbadenis · January 27, 2025, 8:02am

Hello
Having a problem on many library parts, I would like to create a macro to correct all our errors.
The goal:
1-) If it's a part family, open it and modify it and change the case of $PROPRIETE@CATEGORY to $PROPRIETE@Category (same thing for DESIGNATION and CODE)
2-) List all the configurations of the part, and all the properties of each configuration, if They are in capital letters modify the case (CODE will become Code) to do this go through a provisional property to retrieve the value and put it back in the create property with the modified case.
3-) Upgrade thread representations functions and custom properties

If you have examples for any of the points, I'm interested in it, in order to save time.
The macro will then be run in batch thanks to integration.

Batch properties answers point 2 but does not correct 1 and 3 and as there are many parts I am looking for the most effective method.

Thank you

sbadenis · January 27, 2025, 8:33am

For the 2 I found the solution (still to improve it slightly):

Option Explicit

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        PrintConfigurationSpecificProperties swModel, True

    Else
        MsgBox "Please open model"
    End If
    
End Sub


Sub PrintConfigurationSpecificProperties(model As SldWorks.ModelDoc2, cached As Boolean)
    
    Dim vNames As Variant
    vNames = model.GetConfigurationNames()
    
    Dim i As Integer
    
    Debug.Print "Configuration Specific Properties"
    
    For i = 0 To UBound(vNames)
        
        Dim confName As String
        confName = vNames(i)
        
        Dim swCustPrpMgr As SldWorks.CustomPropertyManager
        Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)
        
        Debug.Print "    " & confName
        PrintProperties swCustPrpMgr, cached, "        "
        
    Next
    
End Sub




Sub PrintProperties(custPrpMgr As SldWorks.CustomPropertyManager, cached As Boolean, indent As String)
    
    Dim vPrpNames As Variant
    vPrpNames = custPrpMgr.GetNames()
    
    Dim i As Integer
    
    If Not IsEmpty(vPrpNames) Then
    
        For i = 0 To UBound(vPrpNames)
            
            Dim prpName As String
            prpName = vPrpNames(i)
            
            Dim prpVal As String
            Dim prpResVal As String
            Dim wasResolved As Boolean
            Dim isLinked As Boolean
            
            Dim res As Long
            res = custPrpMgr.Get6(prpName, cached, prpVal, prpResVal, wasResolved, isLinked)
            
            Dim status As String
            Select Case res
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_CachedValue
                    status = "Cached Value"
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_ResolvedValue
                    status = "Resolved Value"
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_NotPresent
                    status = "Not Present"
            End Select
            
            Debug.Print indent & "Property: " & prpName
            Debug.Print indent & "Value/Text Expression: " & prpVal
            Debug.Print indent & "Evaluated Value: " & prpResVal
            Debug.Print indent & "Was Resolved: " & wasResolved
            Debug.Print indent & "Is Linked: " & isLinked
            Debug.Print indent & "Status: " & status
            Debug.Print ""
            If prpName = "CATEGORIE" Then
            Debug.Print "texte en majuscule"
            'On supprime la propriété
            custPrpMgr.Delete "CATEGORIE"
            'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
            custPrpMgr.Add3 "Categorie", 30, prpVal, swCustomPropertyReplaceValue
            'swCustPropMgr.Add3 "Categorie", 30, "", 0

            

            End If
        Next
    Else
        Debug.Print indent & "-No Properties-"
    End If
    
End Sub

There are still points 1 and 3

Maclane · January 27, 2025, 9:18am

Hello;
For points 1 and 2, why not manage them directly in integration?
=> Pay attention to the " Configuration " integration options

(okay it doesn't open the part family in Excel but it will update itself)
for point n°3 I propose the Code Stack macro
https://www.codestack.net/solidworks-api/document/upgrade-cosmetic-threads/

'**********************
'Copyright(C) 2025 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/document/upgrade-cosmetic-threads/
'License: https://www.codestack.net/license/
'**********************

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()

    Set swApp = Application.SldWorks

    Dim allowUpgrade As Boolean
    allowUpgrade = swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swEnableAllowCosmeticThreadsUpgrade)

try:
    On Error GoTo catch
    
    Set swModel = swApp.ActiveDoc
        
    If Not swModel Is Nothing Then
                
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swEnableAllowCosmeticThreadsUpgrade, True
        
        If False = swModel.Extension.UpgradeLegacyCThreads() Then
            Debug.Print "Thread is not upgraded"
        End If
            
    Else
        Err.Raise vbError, "", "Please open document"
    End If
    
    GoTo finally
    
catch:
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
finally:
    
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swEnableAllowCosmeticThreadsUpgrade, allowUpgrade

End Sub

Kind regards.

sbadenis · January 27, 2025, 9:57am

For Integration it does not work with a property of the same name (already tested via ticket hotline)
The only method was to go through batchproperties.
Retrieve the value of the CODE property in a temp property.
Delete the CODE property, create the Code property, inject it with the value of prop temp, and then delete the propr temp...
This works well for properties but it doesn't change the names of the columns in the room family table (and if we add a new row-> problem again!)

On the other hand, for the 2nd part it should help me a lot!
Thank you @Maclane

sbadenis · January 27, 2025, 10:41am

I move forward with the modification of the part family, I get the value but impossible to modify it with the setEntryText function:
I tried:

swDesTable.SetEntryText(i, j, "$Test") 'erreur de syntaxe et de compilation
bRet=swDesTable.SetEntryText(i, j, "$Test") 'erreur de compilation fonction ou variable attendue

If anyone has any idea how to formulate my function
The full code:

'---------------------------------------
' Preconditions:
' 1. Open a part or assembly document that
'    contains a design table.
' 2. Verify that a design table exists by
'    expanding Tables in the ConfigurationManager.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Prints the design table contents to the
'    Immediate window.
' 2. Examine the Immediate window.
'----------------------------------------
Option Explicit
Sub main()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swDesTable              As SldWorks.DesignTable
    Dim nTotRow                 As Long
    Dim nTotCol                 As Long
    Dim sRowStr                 As String
    Dim i                       As Long
    Dim j                       As Long
    Dim bRet                    As Boolean
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc

    Set swDesTable = swModel.GetDesignTable
    bRet = swDesTable.Attach

    Debug.Assert bRet
    nTotRow = swDesTable.GetTotalRowCount
    nTotCol = swDesTable.GetTotalColumnCount
    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  Title        = " & swDesTable.GetTitle
    Debug.Print "  Row          = " & swDesTable.GetRowCount
    Debug.Print "  Col          = " & swDesTable.GetColumnCount
    Debug.Print "  TotRow       = " & nTotRow
    Debug.Print "  TotCol       = " & nTotCol
    Debug.Print "  VisRow       = " & swDesTable.GetVisibleRowCount
    Debug.Print "  VisCol       = " & swDesTable.GetVisibleColumnCount
    Debug.Print ""
    
    For i = 0 To nTotRow
        sRowStr = "  |"
        For j = 0 To nTotCol
        If i = 0 Then sRowStr = sRowStr + swDesTable.GetEntryText(i, j) + "|"
        If swDesTable.GetEntryText(i, j) = "$DESCRIPTION" Then
        Debug.Print "Valeure trouvée!!!"
        'Code pour ré-écrie la valeure de la colonne
       swDesTable.SetEntryText(i, j, "$Test")
       
        End If
        Next j
        Debug.Print sRowStr
    Next i
    swDesTable.Detach
    'bRet = swApp.Visible
    'Shell "taskkill /f /im excel.exe", vbHide
End Sub

EDIT: I just found it, rookie mistake...

swDesTable.SetEntryText i, j, "$Test" '

sbadenis · January 27, 2025, 2:03pm

For point 3 part 1 the @Maclane code works perfectly
For point 3 part 2 ->update the properties to the new architecture:

'**********************
'Copyright(C) 2025 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/data-storage/custom-properties/update-legacy/
'License: https://www.codestack.net/license/
'**********************

Const UPDATE_ALL_COMPS As Boolean = True
Const REBUILD_ALL_CONFIGS As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    swModel.Extension.UpgradeLegacyCustomProperties UPDATE_ALL_COMPS
    
    If REBUILD_ALL_CONFIGS Then
        swModel.Extension.ForceRebuildAll
    End If
    
End Sub

sbadenis · January 28, 2025, 6:35am

I'm posting the latest full version that does the trick:

Option Explicit

Const UPDATE_ALL_COMPS As Boolean = True
Const REBUILD_ALL_CONFIGS As Boolean = False 'Mettre true pour reconstruire toutes les configurations (attention peut être très long sur grande famille de pièces)

Dim swApp                   As SldWorks.SldWorks
Dim enLectureSeule          As Boolean
Dim PathName                As String
Dim bRet                    As Boolean
Dim errorsSave              As Long
Dim warnings                As Long

Sub main()
    enLectureSeule = False
    Set swApp = Application.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        'On vérifie si la pièce est en lecture seule
        If swModel.IsOpenedReadOnly Then
            Debug.Print "Fichier en lecture seule"
            enLectureSeule = True
            'On enlève la lecture seule
            PathName = UCase(swModel.GetPathName)
            SetAttr PathName, vbNormal
            swModel.FileReload
            bRet = swModel.ReloadOrReplace(False, swModel.GetPathName, True)
            swModel.FileReload
        End If
             
        'On passe au nouveau mode de représentation de filetage
            Dim allowUpgrade As Boolean
        allowUpgrade = swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swEnableAllowCosmeticThreadsUpgrade)
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swEnableAllowCosmeticThreadsUpgrade, True
        
        If False = swModel.Extension.UpgradeLegacyCThreads() Then
            Debug.Print "Thread is not upgraded"
        End If
        
        
        'On passe au nouveau mode d'affichage des propriétés personnalisées
        swModel.Extension.UpgradeLegacyCustomProperties UPDATE_ALL_COMPS
        
        'Modification de la table de famille de pièce
        Dim swDesTable              As SldWorks.DesignTable
        Dim nTotRow                 As Long
        Dim nTotCol                 As Long
        Dim sRowStr                 As String
        Dim i                       As Long
        Dim j                       As Long
        
        Set swDesTable = swModel.GetDesignTable
        
        
        bRet = swDesTable.Attach
        
        'Debug.Assert bRet
        nTotRow = swDesTable.GetTotalRowCount
        nTotCol = swDesTable.GetTotalColumnCount
        Debug.Print "File = " & swModel.GetPathName
        Debug.Print "  Title        = " & swDesTable.GetTitle
        Debug.Print "  Row          = " & swDesTable.GetRowCount
        Debug.Print "  Col          = " & swDesTable.GetColumnCount
        Debug.Print "  TotRow       = " & nTotRow
        Debug.Print "  TotCol       = " & nTotCol
        Debug.Print "  VisRow       = " & swDesTable.GetVisibleRowCount
        Debug.Print "  VisCol       = " & swDesTable.GetVisibleColumnCount
        Debug.Print ""
        
        For i = 0 To nTotRow
            sRowStr = "  |"
            For j = 0 To nTotCol
            If i = 0 Then sRowStr = sRowStr + swDesTable.GetEntryText(i, j) + "|"
            
            If swDesTable.GetEntryText(i, j) = "$DESCRIPTION" Then
                swDesTable.SetEntryText i, j, "$Description2"
                swDesTable.SetEntryText i, j, "$Description"
            End If
        
            If swDesTable.GetEntryText(i, j) Like "$*DESIGNATION" Then
                swDesTable.SetEntryText i, j, "$Propriete@Designation2"
                swDesTable.SetEntryText i, j, "$Propriete@Designation"
            End If
        
            If swDesTable.GetEntryText(i, j) Like "$*CODE GUELT" Then
                swDesTable.SetEntryText i, j, "$Propriete@Code Guelt2"
                swDesTable.SetEntryText i, j, "$Propriete@Code Guelt"
            End If
        
            If swDesTable.GetEntryText(i, j) Like "$*CODE" Then
                swDesTable.SetEntryText i, j, "$Propriete@Code2"
                swDesTable.SetEntryText i, j, "$Propriete@Code"
            End If
            
        
            If swDesTable.GetEntryText(i, j) Like "$*CATEGORIE" Then
                swDesTable.SetEntryText i, j, "$Propriete@Categorie2"
                swDesTable.SetEntryText i, j, "$Propriete@Categorie"
            End If
                    
        
            If swDesTable.GetEntryText(i, j) Like "$*FOURNISSEUR" Then
                swDesTable.SetEntryText i, j, "$Propriete@Fournisseur2"
                swDesTable.SetEntryText i, j, "$Propriete@Fournisseur"
            End If
                      
            Next j
            Debug.Print sRowStr
        Next i
        swDesTable.Detach
        
               
        'On lance la fonction recherche des propriété à modifier
        PrintConfigurationSpecificProperties swModel, True


        'On reconstruit toutes les configs si besoin (suivant constante REBUILD_ALL_CONFIGS -> True or False)
        If REBUILD_ALL_CONFIGS Then
            swModel.Extension.ForceRebuildAll
        End If
        
        'Vue iso avant sauvegarde et zoom tout
        swModel.ShowNamedView2 "*Isométrique", 7
        swModel.ViewZoomtofit2
        
        'On sauvegarde
        bRet = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errorsSave, warnings)
        If bRet = False Then
                Debug.Print "Save errors (8192 = Saving an assembly with renamed components requires saving the references): " & errorsSave
        End If
        
        
        
        
        
            
        'on remet la lecture seule si activé au départ
        If enLectureSeule = True Then
                SetAttr PathName, vbReadOnly
                'Si oui, on met la lecture seule dans Windows
                swModel.FileReload
                bRet = swModel.ReloadOrReplace(False, swModel.GetPathName, True)
                swModel.FileReload
        End If
        
    Else
        MsgBox "Please open model"
    End If
    
End Sub


Sub PrintConfigurationSpecificProperties(model As SldWorks.ModelDoc2, cached As Boolean)
    
    Dim vNames As Variant
    vNames = model.GetConfigurationNames()
    
    Dim i As Integer
    
    Debug.Print "Configuration Specific Properties"
    
    For i = 0 To UBound(vNames)
        
        Dim confName As String
        confName = vNames(i)
        
        Dim swCustPrpMgr As SldWorks.CustomPropertyManager
        Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)
        
        Debug.Print "    " & confName
        PrintProperties swCustPrpMgr, cached, "        "
        
    Next
    
End Sub




Sub PrintProperties(custPrpMgr As SldWorks.CustomPropertyManager, cached As Boolean, indent As String)
    
    Dim vPrpNames As Variant
    vPrpNames = custPrpMgr.GetNames()
    
    Dim i As Integer
    
    If Not IsEmpty(vPrpNames) Then
    
        For i = 0 To UBound(vPrpNames)
            
            Dim prpName As String
            prpName = vPrpNames(i)
            
            Dim prpVal As String
            Dim prpResVal As String
            Dim wasResolved As Boolean
            Dim isLinked As Boolean
            
            Dim res As Long
            res = custPrpMgr.Get6(prpName, cached, prpVal, prpResVal, wasResolved, isLinked)
            
            Dim status As String
            Select Case res
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_CachedValue
                    status = "Cached Value"
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_ResolvedValue
                    status = "Resolved Value"
                Case swCustomInfoGetResult_e.swCustomInfoGetResult_NotPresent
                    status = "Not Present"
            End Select
            
            Debug.Print indent & "Property: " & prpName
            Debug.Print indent & "Value/Text Expression: " & prpVal
            Debug.Print indent & "Evaluated Value: " & prpResVal
            Debug.Print indent & "Was Resolved: " & wasResolved
            Debug.Print indent & "Is Linked: " & isLinked
            Debug.Print indent & "Status: " & status
            Debug.Print ""
            
            If prpName = "CATEGORIE" Then
                'On supprime la propriété
                custPrpMgr.Delete "CATEGORIE"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Categorie", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
            If prpName = "CODE" Then
                'On supprime la propriété
                custPrpMgr.Delete "CODE"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Code", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
            If prpName = "CODE GUELT" Then
                'On supprime la propriété
                custPrpMgr.Delete "CODE GUELT"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Code Guelt", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
            If prpName = "FOURNISSEUR" Then
                'On supprime la propriété
                custPrpMgr.Delete "FOURNISSEUR"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Fournisseur", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
            If prpName = "DESIGNATION" Then
                'On supprime la propriété
                custPrpMgr.Delete "DESIGNATION"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Designation", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
            
            If prpName = "DESCRIPTION" Then
                Debug.Print "texte en majuscule"
                'On supprime la propriété
                custPrpMgr.Delete "DESCRIPTION"
                'Création de la propriété avec changement de casse et la valeure de l'ancienne propriété
                custPrpMgr.Add3 "Description", 30, prpVal, swCustomPropertyReplaceValue
            End If
            
        Next
    Else
        Debug.Print indent & "-No Properties-"
    End If
    
End Sub

For the best answer I give it to @Maclane who gave me part of the answer and a clue for the 2nd part.

Maclane · January 28, 2025, 7:55am

Thanks for sharing. (This gives me some ideas).
Note: well thought out for the return to " Read Only " I would have missed it.

That's generous! To the charge of revenge ...

Cyril_f · January 28, 2025, 8:26am

Hello
I would have to test the code occasionally because for my part (Excel part family) it never wanted to pass the SetEntryText (among other things why I didn't answer the topic because I didn't have time to debug )

sbadenis · January 28, 2025, 8:32am

@Cyril_f I have just passed more than 2000 pieces and just 2 pieces that have been a problem since the beginning.
And once opened the bug remains manually, family of parts impossible to open:

So not related to macro.
After depending on the version of excel maybe it plays. And don't forget to put the reference to excel in the editor, but I imagine that was your case!

Cyril_f · January 28, 2025, 9:16am

Yes, it was my case (for Excel references).
For the memory problem should try to unload Excel from memory if the crash comes from him.
Otherwise if it's a vba macro that opens the files there is a moment when the memory saturates (it's a bug in the api), you have to close SW and restart (I was confronted with this a short time ago and I have a PC with 64GB of RAM)

sbadenis · January 28, 2025, 9:32am

Thanks @Cyril_f but it's a bug in the parts. It repeats on several PCs as soon as SW is opened, so not related to the macro at all.
And waiting for a hotline response on the subject.