Verander het hoofdlettergebruik van een eigenschap

[sbadenis]

Hallo
Omdat ik een probleem heb met veel bibliotheekonderdelen, wil ik een macro maken om al onze fouten te corrigeren.
Het doel:
1-) Als het een deelfamilie is, open het dan en wijzig het en verander het hoofdlettergebruik van $PROPRIETE@CATEGORY in $PROPRIETE@Category (hetzelfde geldt voor AANDUIDING en CODE)
2-) Maak een lijst van alle configuraties van het onderdeel en alle eigenschappen van elke configuratie, als ze in hoofdletters zijn wijzigen de hoofdletter (CODE wordt code) om dit te doen, ga je door een voorlopige eigenschap om de waarde op te halen en zet je deze terug in de create-eigenschap met de gewijzigde behuizing.
3-) Upgrade draadweergavefuncties en aangepaste eigenschappen

Als je voorbeelden hebt voor een van de punten, ben ik daarin geïnteresseerd, om tijd te besparen.
De macro wordt dan dankzij de integratie in batch uitgevoerd.

Batch-eigenschappen beantwoorden punt 2 maar corrigeren 1 en 3 niet, en omdat er veel onderdelen zijn, ben ik op zoek naar de meest effectieve methode.

Bedankt

[sbadenis]

Voor de 2 heb ik de oplossing gevonden (nog om het iets te verbeteren):

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

Er zijn nog de punten 1 en 3

[Maclane]

Hallo;
Waarom zou u de punten 1 en 2 niet rechtstreeks in de integratie beheren?
=> Let op de " Configuratie " integratie-opties

(oke, het opent de onderdeelfamilie niet in Excel, maar het zal zichzelf bijwerken)
voor punt n°3 stel ik de Code Stack macro voor

Upgrade cosmetische schroefdraad in actief SOLIDWORKS-onderdeel of assemblage met behulp van...

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

Vriendelijke groeten.

[sbadenis]

Voor integratie werkt het niet met een woning met dezelfde naam (al getest via tickethotline)
De enige methode was om door batchproperties te gaan.
Haal de waarde van de CODE-eigenschap op in een tijdelijke eigenschap.
Verwijder de eigenschap CODE, maak de eigenschap Code, injecteer deze met de waarde van prop temp en verwijder vervolgens de propr temp...
Dit werkt goed voor eigenschappen, maar het verandert niets aan de namen van de kolommen in de familietabel van de kamer (en als we weer een nieuw rij-> probleem toevoegen!)

Aan de andere kant zou het me voor het 2e deel veel moeten helpen!
Dank je wel @Maclane

[sbadenis]

Ik ga verder met de wijziging van de artikelfamilie, ik krijg de waarde, maar onmogelijk om deze te wijzigen met de functie setEntryText:
Ik heb het geprobeerd:

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

Als iemand enig idee heeft hoe ik mijn functie moet formuleren
De volledige 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: Ik heb het net gevonden, rookie fout ...

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

[sbadenis]

Voor punt 3 deel 1 werkt de @Maclane code perfect
Voor punt 3 deel 2 -> de eigenschappen bijwerken naar de nieuwe architectuur:

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

Ik post de nieuwste volledige versie die het lukt:

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

Voor het beste antwoord geef ik het aan @Maclane die me een deel van het antwoord gaf en een aanwijzing voor het 2e deel.

[Maclane]

Bedankt voor het delen. (Dit brengt me op ideeën).
Let op: goed doordacht voor de terugkeer naar " Read Only " zou ik het gemist hebben.

@sbadenis

Voor het beste antwoord geef ik het aan @Maclane die me een deel van het antwoord gaf en een aanwijzing voor het 2e deel.

Dat is genereus! Naar de beschuldiging van wraak ...

[Cyril_f]

Hallo
Ik zou de code af en toe moeten testen omdat het van mijn kant (Excel-deelfamilie) nooit de SetEntryText wilde passeren (onder andere waarom ik het onderwerp niet beantwoordde omdat ik geen tijd had om te debuggen )

[sbadenis]

@Cyril_f Ik ben net meer dan 2000 stuks gepasseerd en slechts 2 stuks die vanaf het begin een probleem zijn geweest.
En eenmaal geopend blijft de bug handmatig, familie van onderdelen onmogelijk te openen:

Dus niet gerelateerd aan macro.
Na afhankelijk te zijn van de versie van Excel, misschien wordt het afgespeeld. En vergeet niet de referentie naar excel in de editor te zetten, maar ik kan me voorstellen dat dat bij jou het geval was!

[Cyril_f]

Ja, dat was mijn geval (voor Excel-referenties).
Voor het geheugenprobleem moet proberen om Excel uit het geheugen te verwijderen als de crash van hem komt.
Anders, als het een vba-macro is die de bestanden opent, is er een moment waarop het geheugen verzadigd raakt (het is een bug in de api), je moet SW sluiten en opnieuw opstarten (ik werd hier kort geleden mee geconfronteerd en ik heb een pc met 64 GB RAM)

[sbadenis]

Bedankt @Cyril_f , maar het is een bug in de onderdelen. Het herhaalt zich op verschillende pc's zodra SW wordt geopend, dus helemaal niet gerelateerd aan de macro.
En wachten op een reactie van de hotline over het onderwerp.