Löschen von benutzerdefinierten Eigenschaften

Hallo

Ich verwende ein Makro, um alle benutzerdefinierten Eigenschaften aus einer Konfiguration zu entfernen.
Ich möchte dies für alle Konfigurationen einer Datei automatisieren?

Es sei denn, Sie haben eine andere Lösung in SW integriert (ohne die Mycadtools-Tools)

Vielen Dank im Voraus

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

Gehen Sie einfach alle Konfigurationen wie in diesem Beispiel durch (über eine Schleife) und nicht nur die aktive Konfiguration (Set swConfig = swConfigMgr.ActiveConfiguration):
https://help.solidworks.com/2020/english/api/sldworksapi/iterate_through_all_configurations_example_vb.htm?verRed

Vielen Dank
Können Sie mir helfen, es in ein vollständiges Makro zu integrieren?
(Ich bin ein Anfänger auf VBA...)

So etwas (ungetestet)

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

Ich habe die Zeile leave if 0 Eigenschaft, die mir Probleme bereitet ...
Wie vermeide ich die " unendliche " Schleife, wenn sie alle Konfigurationen durchlaufen hat?

Ich hatte nicht gesehen, dass es verlassen wird, wenn 0 Eigenschaften mit diesem Code besser sein sollten:

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

Und keine Endlosschleife, da es alle vorhandenen Konfigurationen durchläuft und nur 1 Mal über Ubound (Array aller Konfigurationen)

2 „Gefällt mir“