Usuwanie makr wszystkich oprócz 3 specyficznych właściwości od czasu narysowania

Out of category
1

Cze wszystkim

 

Chcę usunąć wszystkie właściwości solidworks z rysunku z wyjątkiem 3 właściwości (NUMERO_PLAN, INDEKS, DATA).

Znalazłem makro  (patrz załącznik), które usuwa wszystkie zmienne, ale nie wiem, jak dodać wyjątki.

Ktoś ma pomysł?

Z góry dziękuję

 

 


makro1.swp
2

Wystarczy, że dodasz prosty warunek:

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

Lub, jeśli masz narzędzia, użyj narzędzia smartproperties w narzędziach Mycadtools.

Dzięki temu narzędziu możesz nawet nakładać go partiami.

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

 

 

1 polubienie
3

Próbowałem opisanego sposobu  sbadenis, ale nadal usuwa właściwość CODE_ARTICLE &  NUMERO_PLAN

Są to właściwości rysunku

Oto makro

 

Opcja jawna

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

Sub DeleteProps()

Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc

Dim names() Jako ciąg

Ustaw cpm = swModel.Extension.CustomPropertyManager("")
Nazwy = CPM. GetNames (DostaćNazwy)

Dim i As Liczba całkowita
Dla i = 0 Do UBound(nazwy)
Nazwy Debug.Print(i)
Jeśli nazwy(i) <> "CODE_ARTICLE" Lub nazwy(i) <> "NUMERO_PLAN" Następnie cpm. Usuwanie nazw(i)
Następny

Koniec subwoofera


makro1.swp
4

Przepraszam, że musisz umieścić i zamiast złota, ponieważ wymazujesz tak różne od pop& i tak różne od prop2

 

Bądź ostrożny, pęknięcie jest ważne.

Jeśli to konieczne, w fazie testowej możesz spróbować tego:

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

A następnie edytujesz makro i uruchamiasz je z edytora. I sprawdzasz okno wykonywania, pokazuje nazwę właściwości, a następnie nazwę właściwości: Usunięte, jeśli trzeba ją usunąć. W przeciwnym razie przechodzi do następnej właściwości.

Pozwolę ci to obejrzeć.

2 polubienia
5

dziękuję, to rzeczywiście było I że musiałeś umieścić