Zmienianie wielkości liter we właściwości

Witam
Mając problem z wieloma elementami bibliotecznymi, chciałbym stworzyć makro, aby poprawić wszystkie nasze błędy.
Cel pracy:
1-) Jeśli jest to rodzina części, otwórz ją i zmodyfikuj, a następnie zmień wielkość liter $PROPRIETE@KATEGORIA na $PROPRIETE@Kategoria (to samo dotyczy OZNACZENIA i KODU)
2-) Wymień wszystkie konfiguracje części i wszystkie właściwości każdej konfiguracji, jeśli są wielkimi literami, zmodyfikuj wielkość liter (KOD stanie się kodem), aby to zrobić, przejdź przez właściwość tymczasową, aby pobrać wartość i umieścić ją z powrotem we właściwości create ze zmodyfikowanym przypadkiem.
3-) Uaktualnij funkcje reprezentacji gwintu i właściwości niestandardowe

Jeśli masz przykłady dla któregoś z punktów, jestem nim zainteresowany, aby zaoszczędzić czas.
Makro zostanie następnie uruchomione wsadowo dzięki integracji.

Właściwości partii odpowiada na punkt 2, ale nie koryguje 1 i 3, a ponieważ jest wiele części, szukam najskuteczniejszej metody.

Dziękuję

1 polubienie

Dla 2 znalazłem rozwiązanie (jeszcze, aby je nieco poprawić):

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

Pozostały jeszcze punkty 1 i 3

Witam;
W przypadku punktów 1 i 2, dlaczego nie zarządzać nimi bezpośrednio w integracji?
=> Zwróć uwagę na opcje integracji " Konfiguracja ".
image
(okej, nie otwiera rodziny części w Excelu, ale sam się zaktualizuje)
dla punktu nr 3 proponuję makro 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

Pozdrowienia.

W przypadku integracji nie działa z właściwością o tej samej nazwie (już przetestowaną za pośrednictwem infolinii zgłoszeniowej)
Jedyną metodą było przejście przez batchproperties.
Pobiera wartość właściwości CODE we właściwości temp.
Usuń właściwość CODE, utwórz właściwość Code, wstrzyknij ją z wartością prop temp, a następnie usuń właściwość temp...
Działa to dobrze w przypadku właściwości, ale nie zmienia nazw kolumn w tabeli rodziny pomieszczeń (i jeśli ponownie dodamy nowy problem z > wierszy!)

Z drugiej strony, w 2 części powinno mi to bardzo pomóc!
Dziękujemy@Maclane

Przechodzę do modyfikacji rodziny części, otrzymuję wartość, ale nie mogę jej zmodyfikować za pomocą funkcji setEntryText:
Próbowałem:

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

Jesli ktos ma jakis pomysl jak sformułowac moja funkcja
Pełny kod:

'---------------------------------------
' 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: Właśnie to znalazłem, błąd nowicjusza...

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

Dla punktu 3 część 1 kod @Maclane działa idealnie
Dla punktu 3 część 2 ->aktualizacja właściwości do nowej architektury:

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

Zamieszczam najnowszą pełną wersję, która załatwia sprawę:

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




Aby uzyskać najlepszą odpowiedź, daję ją @Maclane , która dała mi część odpowiedzi i wskazówkę do drugiej części.

2 polubienia

Dzięki za udostępnienie. (To daje mi kilka pomysłów).
Uwaga: dobrze przemyślane na powrót do " Tylko do odczytu " Tęskniłbym za tym.

:grinning: To hojne! Do oskarżenia o zemstę... :grin:

1 polubienie

Witam
Musiałbym od czasu do czasu testować kod, ponieważ z mojej strony (rodzina części Excel) nigdy nie chciał przekazać SetEntryText (między innymi dlatego nie odpowiedziałem na temat, bo nie miałem czasu na debugowanie :slight_smile: )

@Cyril_f Właśnie przeszedłem ponad 2000 sztuk i tylko 2 sztuki, które stanowiły problem od samego początku.
A po otwarciu błąd pozostaje ręcznie, rodzina części nie jest możliwa do otwarcia:
image
Czyli nie ma to związku z makro.
Po zaleznosci od wersji excela moze to gra. I nie zapomnij umieścić odniesienia do programu Excel w edytorze, ale wyobrażam sobie, że tak było w Twoim przypadku!
image

Tak, tak było w moim przypadku (dla referencji Excel).
Z powodu problemu z pamięcią należy spróbować rozładować Excela z pamięci, jeśli awaria pochodzi od niego.
W przeciwnym razie, jeśli jest to makro vba, które otwiera pliki, następuje moment, w którym pamięć się wysyci (to błąd w api), trzeba zamknąć oprogramowanie i zrestartować (miałem z tym do czynienia jakiś czas temu i mam komputer z 64GB RAM)

Dzięki @Cyril_f ale to błąd w częściach. Powtarza się na kilku komputerach, gdy tylko oprogramowanie zostanie otwarte, więc w ogóle nie jest związane z makrem.
I czekam na odpowiedź infolinii w tym temacie.

1 polubienie