Macro verwijdering op 3 na alle specifieke eigenschappen sinds tekening

Hoi allemaal

 

Ik wil alle solidworks-eigenschappen van een tekening verwijderen, behalve 3 eigenschappen (NUMERO_PLAN, INDEX, DATE).

Ik heb een macro  gevonden (zie bijlage) die alle variabelen verwijdert, maar ik weet niet hoe ik uitzonderingen moet toevoegen.

Iemand een idee?

Bij voorbaat dank

 

 


macro1.swp

U hoeft alleen maar een eenvoudige voorwaarde toe te voegen:

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

Of als je de tools hebt, gebruik dan de smartproperties-tool van de Mycadtools-hulpprogramma's.

Met dit hulpprogramma kun je het zelfs in batches toepassen.

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

 

 

1 like

Ik heb de manier geprobeerd om sbadenis te  beschrijven , maar het verwijdert nog steeds de CODE_ARTICLE en  NUMERO_PLAN eigenschap 

Dit zijn de eigenschappen van een tekening

Hier is de macro

 

Optie Expliciete

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

Sub DeleteProps()

Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in

Dim namen() als tekenreeks

Stel cpm in = swModel.Extension.CustomPropertyManager("")
Namen = CPM. Namen ophalen

Dim i als geheel getal
Voor i = 0 Naar UBound(namen)
Fouten opsporen.Namen afdrukken(i)
Als namen (i) <> "CODE_ARTICLE" Of namen (i) <> "NUMERO_PLAN" Dan cpm. Namen schrappen(i)
Volgend

Einde Sub


macro1.swp

Sorry dat je een en moet zetten in plaats van goud omdat je zo anders dan pop& en zo anders dan prop2 uitwist

 

Wees voorzichtig, de breuk is belangrijk.

Indien nodig voor de testfase kunt u dit proberen:

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

En dan bewerk je je macro en start je hem vanuit de editor. En u controleert uw uitvoeringsvenster, het toont u de naam van de eigenschap en vervolgens de naam van de eigenschap: Verwijderd als deze moet worden verwijderd. Anders gaat het verder naar het volgende eigendom.

Ik laat je dat kijken.

2 likes

dank je wel dat het inderdaad was En dat je moest zetten