Aangepaste eigenschappen verwijderen

Macro
1

Hallo

Ik gebruik een macro om alle aangepaste eigenschappen uit een configuratie te verwijderen.
Ik wil dit automatiseren naar alle configuraties van een bestand?

Tenzij u een andere oplossing heeft geïntegreerd met SW (zonder de Mycadtools-tools)

Bij voorbaat dank

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

Doorloop gewoon alle configuraties zoals in dit voorbeeld (via een lus) in plaats van alleen de actieve configuratie (Set swConfig = swConfigMgr.ActiveConfiguration):
https://help.solidworks.com/2020/english/api/sldworksapi/iterate_through_all_configurations_example_vb.htm?verRed

3

Bedankt
Kunt u mij helpen het te integreren op een volledige macro?
(Ik ben een beginner op VBA...)

4

Zoiets als dit (niet getest)

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

Ik laat de lijn vertrekken als 0 eigenschap die me problemen bezorgt...
Is hoe de " oneindige " lus te vermijden wanneer het is gegaan door alle configuraties?

6

Ik had het niet zien vertrekken als 0 eigenschappen met deze code beter zou moeten zijn:

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

En geen oneindige lus omdat het door alle bestaande configuraties gaat en slechts 1 keer via Ubound (array van alle configuraties)

2 likes