Macro suppression toutes propriétés sauf 3 spécifique depuis mise en plan

Out of category
1

Bonjour à tous ,

 

Je cherche à supprimer toutes les propriétés solidworks d'une mise en plan sauf 3 propriétés (NUMERO_PLAN, INDICE, DATE).

J'ai trouvé une macro  (voir pièce jointe ) qui supprime toutes les variables mais je ne sais pas comment ajouter des exceptions.

Quelqu'un aurait une idée?

Merci d'avance

 

 


macro1.swp
2

Il faut juste ajouter une simple condition:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim cpm As CustomPropertyManager

Sub DeleteProps()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Dim names() As String

Set cpm = swModel.Extension.CustomPropertyManager("")
names = cpm.GetNames

Dim i As Integer
For i = 0 To UBound(names)
Debug.Print names(i)
If names(i) <> "PROP1" Or names(i) <> "PROP2" Or names(i) <> "PROP3" Then cpm.Delete names(i)
Next

End Sub

Ou sinon comme tu as les outils utilise l'outil smartproperties des utilitaires Mycadtools.

Avec cet utilitaire tu pourra même l'appliquer en lot.

https://help.visiativ.com/mycadtools/2020/fr/BatchProperties.html

 

 

1 « J'aime »
3

j'ai essayé la facon  décrite sbadenis, mais ca me supprime quand même la propriété  CODE_ARTICLE &  NUMERO_PLAN

ce sont les propriétés d'une mise en plan

voici la macro

 

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim cpm As CustomPropertyManager

Sub DeleteProps()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Dim names() As String

Set cpm = swModel.Extension.CustomPropertyManager("")
names = cpm.GetNames

Dim i As Integer
For i = 0 To UBound(names)
Debug.Print names(i)
If names(i) <> "CODE_ARTICLE" Or names(i) <> "NUMERO_PLAN" Then cpm.Delete names(i)
Next

End Sub


macro1.swp
4

Désolé il faut mettre un and au lieu de or parce que l'on efface si différent de pop& et si différent de prop2

 

Attention la casse est importante.

Au besoin pour la phase de test tu peux essayé çà:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim cpm As CustomPropertyManager

Sub DeleteProps()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Dim names() As String

Set cpm = swModel.Extension.CustomPropertyManager("")
names = cpm.GetNames

Dim i As Integer
For i = 0 To UBound(names)
Debug.Print names(i)
If names(i) <> "Prop1" And names(i) <> "Prop2" Then Debug.Print names(i) & ": Effacé"
'If names(i) <> "Prop1" And names(i) <> "Prop2" Then cpm.Delete names(i)

Next

End Sub

Et ensuite tu édite ta macro et tu la lance depuis l'éditeur. Et tu vérifie ta fenêtre d'exécution il t'affiche le nom de la propriété puis le nom de la propriété: Effacé si il doit l'effacer. Sinon il passe à la propriété suivante.

Je te laisse regardé ça.

2 « J'aime »
5

merci c'était effectivement And qu'il fallait mettre