Usuwanie właściwości niestandardowych

Macro
1

Witam

Używam makra do usuwania wszystkich właściwości niestandardowych z konfiguracji.
Chciałbym to zautomatyzować we wszystkich konfiguracjach pliku?

Chyba, że masz inne rozwiązanie zintegrowane z oprogramowaniem (bez narzędzi Mycadtools)

Z góry dziękuję

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

Po prostu przejdź przez wszystkie konfiguracje, jak w tym przykładzie (za pomocą pętli), a nie tylko aktywną konfigurację (Set swConfig = swConfigMgr.ActiveConfiguration):
https://help.solidworks.com/2020/english/api/sldworksapi/iterate_through_all_configurations_example_vb.htm?verRed

3

Dziękuję
Czy mógłbyś mi pomóc zintegrować go z pełnym makrem?
(Jestem początkującym w VBA...)

4

Coś takiego (nieprzetestowane)

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

Mam właściwość opuść wiersz, jeśli 0, która sprawia mi problemy...
Czy jak uniknąć pętli " nieskończoności ", gdy przeszła przez wszystkie konfiguracje?

6

Nie widziałem, aby odchodził, jeśli 0 właściwości z tym kodem powinny być lepsze:

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

I nie ma nieskończonej pętli, ponieważ przechodzi przez wszystkie istniejące konfiguracje i tylko 1 raz przez Ubound (tablica wszystkich konfiguracji)

2 polubienia