Makroentfernung aller bis auf 3 spezifische Eigenschaften seit dem Zeichnen

Out of category
1

Hallo ihr alle

 

Ich möchte alle SolidWorks-Eigenschaften aus einer Zeichnung entfernen, mit Ausnahme von 3 Eigenschaften (NUMERO_PLAN, INDEX, DATE).

Ich habe ein Makro  gefunden (siehe Anhang), das alle Variablen entfernt, aber ich weiß nicht, wie ich Ausnahmen hinzufügen kann.

Hat jemand eine Idee?

Vielen Dank im Voraus

 

 


Makro1.swp
2

Sie müssen nur eine einfache Bedingung hinzufügen:

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

Oder wenn Sie die Werkzeuge haben, verwenden Sie das smartproperties-Tool der Mycadtools-Dienstprogramme.

Mit diesem Dienstprogramm können Sie es sogar stapelweise anwenden.

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

 

 

1 „Gefällt mir“
3

Ich habe den beschriebenen Weg  sbadenis ausprobiert, aber es entfernt immer noch die CODE_ARTICLE &  NUMERO_PLAN Eigenschaft 

Dies sind die Eigenschaften einer Zeichnung

Hier ist das Makro

 

Option Explizit

Dim swApp als SldWorks.SldWorks
Dim swModel As ModelDoc2
Dimmen von cpm als CustomPropertyManager

Sub DeleteProps()

Legen Sie swApp = Application.SldWorks fest
Festlegen von swModel = swApp.ActiveDoc

Dim names() als Zeichenkette

Legen Sie cpm = swModel.Extension.CustomPropertyManager("") fest
Namen = CPM. GetNames (Namen)

Dim i As Integer
Für i = 0 Bis UBound(Namen)
Debug.Drucknamen(i)
Wenn names(i) <> "CODE_ARTICLE" Oder names(i) <> "NUMERO_PLAN" Dann cpm. Namen(i) löschen
Nächster

Ende Sub


Makro1.swp
4

Tut mir leid, dass du ein und anstelle von Gold setzen musst, weil du so anders als pop& und so anders als prop2 löschst

 

Seien Sie vorsichtig, der Bruch ist wichtig.

Falls es für die Testphase notwendig ist, können Sie dies ausprobieren:

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

Und dann bearbeiten Sie Ihr Makro und starten es über den Editor. Und wenn Sie Ihr Ausführungsfenster überprüfen, wird Ihnen der Name der Eigenschaft und dann der Name der Eigenschaft angezeigt: Gelöscht, wenn sie gelöscht werden muss. Andernfalls wird mit der nächsten Eigenschaft fortgefahren.

Ich lasse dich das anschauen.

2 „Gefällt mir“
5

Danke, es war in der Tat Und dass du setzen musstest,