Modifier la casse d'une propriété

sbadenis · Janvier 27, 2025, 8:02

Bonjour,
Ayant un problème sur de nombreuses pièce de bibliothèques, je souhaiterais créer une macro pour corriger toute nos erreurs.
Le but:
1-) Si c’est une famille de pièce l’ouvrir et modifier et dan le nom de colonne changer la casse de $PROPRIETE@CATEGORIE en $PROPRIETE@Categorie (même chose pour DESIGNATION et CODE)
2-) Lister toutes les configurations de la pièce, et toute les propriétés de chaque configuration, si Elles sont en majuscules modifier la casse (CODE deviendra Code) pour cela passer par une propriété provisoire pour en récupérer la valeur et la remettre dans la propriété créer avec la casse modifié.
3-) Mettre à niveau les fonctions de représentations de filetage et les propriétés personnalisées

Si vous avez des exemples pour l’un ou l’autre des points je suis preneur, afin de gagner du temps.
La macro sera ensuite lancé en batch grâce à intégration.

Batch properties répond au point 2 mais ne corrige pas le 1 et le 3 et comme les pièces sont nombreuses je cherche la méthode la plus efficace.

Merci

sbadenis · Janvier 27, 2025, 8:33

Pour le 2 j’ai trouvé la solution (reste à l’améliorer légèrement):

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

Il reste le point 1 et 3

Maclane · Janvier 27, 2025, 9:18

Bonjour;
Pour le point n°1et 2 pourquoi ne pas les gérer directement dans integration ?
=> Attentions aux options d’intégration « Configuration »

(d’accord cela n’ouvre pas la famille de pièce sous Excel mais elle se mettra d’elle même à jour)
pour le point n°3 je propose la macro de Code Stack

'**********************
'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

Cordialement.

sbadenis · Janvier 27, 2025, 9:57

Pour Intégration cela ne fonctionne pas avec une propriété de même nom (déjà testé via ticket hotline)
La seule méthode était de passer par batchproperties.
De récupérer la valeur de la propriété CODE dans une propriété temp.
Supprimer la propriété CODE créer la propriété Code lui injecté la valeure de prop temp puis supprimer la propr temp…
Cela fonctionne bien pour les propriétés mais cela ne modifie pas le nom des colonnes dans la table de famille de pièce (et si on ajoute une nouvelle ligne-> re-problème!)

En revanche pour la 2ème partie cela devrait bien m’aider!
Merci @Maclane

sbadenis · Janvier 27, 2025, 10:41

J’avance sur la modification de la famille de pièce, je récupère bien la valeur par contre impossible de la modifier avec la fonction setEntryText:
J’ai essayé:

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

Si quelqu’un à une idée de comment formulé ma fonction
Le code complet:

'---------------------------------------
' 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: je viens de trouver, erreur de débutant…

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

sbadenis · Janvier 27, 2025, 2:03

Pour le point 3 partie 1 le code de @Maclane fonctionne parfaitement
Pour le point 3 partie 2 ->mettre à jour les propriétés vers la nouvelle 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 · Janvier 28, 2025, 6:35

Je poste la dernière version complète qui fait l’affaire:

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

Pour la meilleurs réponse je l’accorde à @Maclane qui m’a donner une partie de la réponse et une piste pour la 2nde partie.

Maclane · Janvier 28, 2025, 7:55

Merci pour le partage. (Cela me donne quelques idées).
Nota : bien pensé pour le retour en « Lecture Seule » je serai passé à coté.

C’est généreux ! A charge de revanche …

Cyril_f · Janvier 28, 2025, 8:26

Bonjour,
Faudrait que je test à l’occasion le code car pour ma part (famille de pièce Excel) il n’a jamais voulu passer le SetEntryText (entre autre pour ça que je n’ai pas répondu au sujet car pas le temps de faire du débug )

sbadenis · Janvier 28, 2025, 8:32

@Cyril_f je viens de passer plus de 2000 pièces et juste 2 pièces qui posent problème depuis le début.
Et une fois ouverte le bug reste manuellement, famille de pièce impossible à ouvrir:

Donc pas lié à la macro.
Après suivant la version d’excel peut-être que cela joue. Et ne pas oublier de mettre la référence à excel dans l’éditeur, mais j’imagines que c’était bien ton cas!

Cyril_f · Janvier 28, 2025, 9:16

Oui c’était mon cas (pour les références Excel).
Pour le problème de mémoire faudrait tester de décharger Excel de la mémoire si le plantage vient de lui.
Sinon si c’est une macro vba qui ouvre les fichiers il y a un moment où la mémoire sature (c’est un bug de l’api), faut fermer SW et relancer (j’ai été confronté à ça il y a peu de temps et j’ai pourtant un PC avec 64Go de RAM)

sbadenis · Janvier 28, 2025, 9:32

Merci @Cyril_f mais c’est un bug des pièces. Il se répète sur plusieurs PC dès l’ouverture de SW, donc pas lié du tout à la macro.
Et en attente d’une réponse hotline sur le sujet.