Ändern der Groß-/Kleinschreibung einer Eigenschaft

Hallo
Da ich ein Problem mit vielen Bibliotheksteilen habe, möchte ich ein Makro erstellen, um alle unsere Fehler zu korrigieren.
Das Ziel:
1-) Wenn es sich um eine Teilefamilie handelt, öffnen Sie sie, ändern Sie sie und ändern Sie die Groß-/Kleinschreibung von $PROPRIETE@CATEGORY in $PROPRIETE@Category (dasselbe gilt für DESIGNATION und CODE)
2-) Listen Sie alle Konfigurationen des Teils und alle Eigenschaften jeder Konfiguration auf, wenn sie in Großbuchstaben vorliegen, ändern Sie den Fall (CODE wird zu Code), um dies zu tun, gehen Sie durch eine provisorische Eigenschaft, um den Wert abzurufen und ihn mit dem geänderten Fall wieder in die create-Eigenschaft einzufügen.
3-) Aktualisieren von Thread-Darstellungen, Funktionen und benutzerdefinierten Eigenschaften

Wenn Sie Beispiele für einen der Punkte haben, bin ich daran interessiert, um Zeit zu sparen.
Dank der Integration wird das Makro dann im Batch ausgeführt.

Batch-Eigenschaften beantwortet Punkt 2, korrigiert aber nicht 1 und 3, und da es viele Teile gibt, suche ich nach der effektivsten Methode.

Vielen Dank

1 „Gefällt mir“

Für die 2 habe ich die Lösung gefunden (noch um sie etwas zu verbessern):

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

Es gibt noch die Punkte 1 und 3

Hallo;
Zu den Punkten 1 und 2, warum nicht direkt in der Integration verwalten?
=> Achten Sie auf die Integrationsmöglichkeiten " Konfiguration "
image
(Okay, es öffnet die Teilefamilie nicht in Excel, aber es wird sich selbst aktualisieren)
Für Punkt Nr. 3 schlage ich das Code-Stack-Makro vor

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

Herzliche Grüße.

Für die Integration funktioniert es nicht mit einer gleichnamigen Immobilie (bereits über Ticket-Hotline getestet)
Die einzige Methode bestand darin, batchproperties zu durchlaufen.
Rufen Sie den Wert der CODE-Eigenschaft in einer temporären Eigenschaft ab.
Löschen Sie die CODE-Eigenschaft, erstellen Sie die Code-Eigenschaft, fügen Sie ihr den Wert prop temp hinzu, und löschen Sie dann die propr temp...
Dies funktioniert gut für Eigenschaften, ändert jedoch nicht die Namen der Spalten in der Raumfamilientabelle (und wenn wir wieder ein neues Zeilen->Problem hinzufügen!)

Auf der anderen Seite sollte es mir für den 2. Teil sehr helfen!
Vielen Dank @Maclane

Ich fahre mit der Änderung der Teilefamilie fort, ich bekomme den Wert, aber es ist unmöglich, ihn mit der Funktion setEntryText zu ändern:
Ich habe versucht:

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

Wenn jemand eine Idee hat, wie ich meine Funktion formulieren soll
Der vollständige 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: Ich habe es gerade gefunden, Anfängerfehler...

swDesTable.SetEntryText i, j, "$Test" '
1 „Gefällt mir“

Für Punkt 3 Teil 1 funktioniert der @Maclane Code einwandfrei
Für Punkt 3 Teil 2 ->Aktualisieren Sie die Eigenschaften auf die neue Architektur:

'**********************
'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
1 „Gefällt mir“

Ich poste die neueste Vollversion, die den Zweck erfüllt:

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




Für die beste Antwort gebe ich sie an @Maclane, der mir einen Teil der Antwort und einen Hinweis für den 2. Teil gegeben hat.

2 „Gefällt mir“

Danke fürs Teilen. (Das gibt mir einige Ideen).
Hinweis: gut durchdacht für die Rückkehr zu " Read Only " hätte ich es verpasst.

:grinning: Das ist großzügig! Zur Anklage der Rache ... :grin:

1 „Gefällt mir“

Hallo
Ich müsste den Code gelegentlich testen, weil er für meinen Teil (Excel-Teilfamilie) nie den SetEntryText übergeben wollte (unter anderem, warum ich das Thema nicht beantwortet habe, weil ich keine Zeit zum Debuggen :slight_smile: hatte)

@Cyril_f habe ich gerade mehr als 2000 Teile passiert und nur 2 Stücke, die von Anfang an ein Problem waren.
Und einmal geöffnet, bleibt der Fehler manuell, die Teilefamilie kann nicht geöffnet werden:
image
Also nicht mit Makro verbunden.
Abhängig von der Excel-Version wird es möglicherweise abgespielt. Und vergessen Sie nicht, den Verweis auf excel in den Editor zu setzen, aber ich kann mir vorstellen, dass das bei Ihnen der Fall war!
image

Ja, das war bei mir der Fall (für Excel-Referenzen).
Für das Speicherproblem sollte versucht werden, Excel aus dem Speicher zu entladen, wenn der Absturz von ihm ausgeht.
Andernfalls, wenn es sich um ein VBA-Makro handelt, das die Dateien öffnet, gibt es einen Moment, in dem der Speicher gesättigt ist (es ist ein Fehler in der API), Sie müssen SW schließen und neu starten (ich wurde vor kurzem damit konfrontiert und habe einen PC mit 64 GB RAM)

Danke @Cyril_f aber es ist ein Fehler in den Teilen. Es wiederholt sich auf mehreren PCs, sobald die SW geöffnet wird, also überhaupt nicht mit dem Makro verbunden.
Und auf eine Hotline-Antwort zu diesem Thema warten.

1 „Gefällt mir“