Supprimer propriétés personnalisées

Macro
1

Bonjour,

J’utilise une macro pour supprimer toutes les propriétés personnalisées d’une configuration.
J’aimerais automatisé ça à toutes les configurations d’un fichier ?

Sauf si vous avez une autre solution intégrée à SW (sans les outils Mycadtools)

Merci d’avance

Sub main()

Dim swApp               As SldWorks.SldWorks
Dim swModelDoc          As SldWorks.ModelDoc2
Dim swConfigMgr         As SldWorks.ConfigurationManager
Dim swConfig            As SldWorks.Configuration
Dim swCustPropMgr       As SldWorks.CustomPropertyManager
Dim NumberOfCustProps   As Long
Dim j                   As Long
Dim vPropNames          As Variant
Dim RetVal              As Boolean
Dim ValOut              As String
Dim ValOut2             As String
Dim CustPropVal         As String

Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
Set swConfigMgr = swModelDoc.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swCustPropMgr = swConfig.CustomPropertyManager

NumberOfCustProps = swCustPropMgr.Count
If NumberOfCustProps = 0 Then Exit Sub
vPropNames = swCustPropMgr.GetNames

For j = 0 To NumberOfCustProps - 1
    RetVal = swCustPropMgr.Get3(vPropNames(j), True, ValOut, ValOut2)
    RetVal = swModelDoc.AddCustomInfo((vPropNames(j)), "Text", ValOut)
    swCustPropMgr.Delete (vPropNames(j))
Next j

End Sub
2

Il suffit de parcourir toute les configurations comme dans cet exemple (via une boucle) au lieu de se contenter de la configuration active (Set swConfig = swConfigMgr.ActiveConfiguration):
https://help.solidworks.com/2020/english/api/sldworksapi/iterate_through_all_configurations_example_vb.htm?verRed

3

Je te remercie
Pourrais tu m’aider à l’intégrer sur une macro complète ?
(je débute sur le VBA…)

4

Quelques chose comme ça (non testé)

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim vConfNameArr As Variant
Dim sConfigName As String
Dim nStart As Single
Dim i As Long
Dim bShowConfig As Boolean
Dim bRet As Boolean
Dim swConfigMgr         As SldWorks.ConfigurationManager
Dim swConfig            As SldWorks.Configuration
Dim swCustPropMgr       As SldWorks.CustomPropertyManager
Dim NumberOfCustProps   As Long
Dim j                   As Long
Dim vPropNames          As Variant
Dim RetVal              As Boolean
Dim ValOut              As String
Dim ValOut2             As String
Dim CustPropVal         As String

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Debug.Print "File = " + swModel.GetPathName
    vConfNameArr = swModel.GetConfigurationNames
'On parcours les différentes config
    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        bShowConfig = swModel.ShowConfiguration2(sConfigName)
        nStart = Timer
        bRebuild = swModel.ForceRebuild3(False)
        Debug.Print "  Configuration = " & sConfigName
        Debug.Print "    Configuration shown? " & bShowConfig
        Debug.Print "    Configuration rebuilt? " & bRebuild
        Debug.Print "    Execution time for this configuration = " & Timer - nStart & " seconds"
'ici le code à ajouter pour suppression des propriétés
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swCustPropMgr = swConfig.CustomPropertyManager

NumberOfCustProps = swCustPropMgr.Count
If NumberOfCustProps = 0 Then Exit Sub
vPropNames = swCustPropMgr.GetNames

For j = 0 To NumberOfCustProps - 1
    RetVal = swCustPropMgr.Get3(vPropNames(j), True, ValOut, ValOut2)
    RetVal = swModel.AddCustomInfo((vPropNames(j)), "Text", ValOut)
    swCustPropMgr.Delete (vPropNames(j))
Next j

'Config suivante
    Next i
End Sub
5

J’ai la ligne quitter si 0 propriété qui me pose probleme…
Est comment éviter la boucle « infinie » lorsqu’il a parcourus toutes les config ?

6

J’avais pas vu le quitter si 0 propriété avec ce code cela devrait être mieux:

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim vConfNameArr As Variant
Dim sConfigName As String
Dim nStart As Single
Dim i As Long
Dim bShowConfig As Boolean
Dim bRet As Boolean
Dim swConfigMgr         As SldWorks.ConfigurationManager
Dim swConfig            As SldWorks.Configuration
Dim swCustPropMgr       As SldWorks.CustomPropertyManager
Dim NumberOfCustProps   As Long
Dim j                   As Long
Dim vPropNames          As Variant
Dim RetVal              As Boolean
Dim ValOut              As String
Dim ValOut2             As String
Dim CustPropVal         As String

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Debug.Print "File = " + swModel.GetPathName
    vConfNameArr = swModel.GetConfigurationNames
'On parcours les différentes config
    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        bShowConfig = swModel.ShowConfiguration2(sConfigName)
        'nStart = Timer
        'bRebuild = swModel.ForceRebuild3(False)
        Debug.Print "  Configuration = " & sConfigName
        'Debug.Print "    Configuration shown? " & bShowConfig
        'Debug.Print "    Configuration rebuilt? " & bRebuild
        'Debug.Print "    Execution time for this configuration = " & Timer - nStart & " seconds"
'ici le code à ajouter pour suppression des propriétés
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swCustPropMgr = swConfig.CustomPropertyManager

NumberOfCustProps = swCustPropMgr.Count
If NumberOfCustProps = 0 Then GoTo Nextconf
vPropNames = swCustPropMgr.GetNames

For j = 0 To NumberOfCustProps - 1
    RetVal = swCustPropMgr.Get3(vPropNames(j), True, ValOut, ValOut2)
    RetVal = swModel.AddCustomInfo((vPropNames(j)), "Text", ValOut)
    swCustPropMgr.Delete (vPropNames(j))
Next j
Nextconf:
'Config suivante
    Next i
End Sub

Et pas de boucle infini puisqu’il parcours toutes les configurations existante et seulement 1 fois via Ubound(array de toute les config)

2 « J'aime »