Code:
Option ExplicitDim swApp As Object
Dim part As Object
Dim infocount As Long
Dim infonames As Variant
Dim x As Integer
Dim z As Integer
Dim y As Integer
Dim confnames As Variant
Dim retval As Boolean
Dim confcount As Long
Dim deletedcountb As Long
Dim deletedcountk As Long
Dim deletedb As String
Dim deletedk As String
Dim msg As String
Public Const infodelcount As Long = 10 'Anzahl der Eigenschaften (Muss hier eingestellt werden)
Public infodel(1 To infodelcount, 1 To 2) As String
Sub main()
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
'################################################################################################'
'# Der String "infodel" hat je 2 Einträge (zweite Zahl) #'
'# "1" als die zweite Zahl definiert den Namen der Eigenschaft (Groß- Kleinschreibung beachten) #'
'# "2" als die zweite Zahl definiert den Typ der Eigenschaft: #'
'# "B" = Benutzerdefinierte Eigenschaft #'
'# "K" = Konfigurationsspezifische Eigenschaft #'
'# Außerdem muss die Anzahl aller Eigenschaften in "infodelcount" definiert werden #'
'################################################################################################'
infodel(1, 1) = "Prüfdatum"
infodel(1, 2) = "B"
infodel(2, 1) = "Prüfer"
infodel(2, 2) = "B"
infodel(3, 1) = "Watermark"
infodel(3, 2) = "B"
infodel(4, 1) = "Bestell_Nummer"
infodel(4, 2) = "B"
infodel(5, 1) = "Bemerkung"
infodel(5, 2) = "B"
infodel(6, 1) = "Prüfdatum"
infodel(6, 2) = "K"
infodel(7, 1) = "Prüfer"
infodel(7, 2) = "K"
infodel(8, 1) = "Watermark"
infodel(8, 2) = "K"
infodel(9, 1) = "Bestellbezeichnung"
infodel(9, 2) = "K"
infodel(10, 1) = "Material"
infodel(10, 2) = "K"
'### Benutzerdefinierte Eigenschaften ###'
If Not part Is Nothing Then
infocount = part.GetCustomInfoCount2("") ' Anzahl der benutzerdef. Eigenschaften im aktiven Teil
infonames = part.GetCustomInfoNames2("") ' Namen der benutzerdef. Eigenschaften im aktiven Teil
deletedcountb = 0 ' Zähler für gelöschte benutz. Eigenschaften
deletedb = "" ' Speicherstring für Namen der benutz. Eigenschaften
For x = 0 To infocount - 1 ' Schleife durch benutzerdefinierte Eigenschaften im Teil
For z = 1 To infodelcount ' Schleife durch alle zu löschenden Eigenschaften
If infodel(z, 2) = "B" Then ' Abfrage ob es sich um eine benutzerdef. Eig. handelt
If infodel(z, 1) = infonames(x) Then ' Falls die Eigenschaft in der Liste steht
retval = part.DeleteCustomInfo2("", infonames(x)) ' Löschen der Eigenschaft
If retval = True Then 'Falls gelöscht wurde
deletedb = deletedb + infonames(x) + Chr(13) ' Speichern der Namen der gelöschten Eigenschaften
deletedcountb = deletedcountb + 1 ' Erfolgszähler + 1
End If
End If
End If
Next z
Next x
'### Konfigurationsspezifische Eigenschaften ###'
confcount = part.GetConfigurationCount() ' Anzahl der Konfigurationen speichern
confnames = part.GetConfigurationNames() ' Namen der Konfigurationen speichern
deletedcountk = 0 ' Zähler für gelöschte benutz. Eigenschaften
deletedk = "" ' Speicherstring für Namen der benutz. Eigenschaften
For y = 0 To confcount - 1 ' Schleife durch alle Konfigurationen
infocount = part.GetCustomInfoCount2(confnames(y)) ' Anzahl konfig. Eigenschaften in der aktiven Konfiguration
infonames = part.GetCustomInfoNames2(confnames(y)) ' Alle Namen der Konf. Eigenschaften in ein Variant einlesen
deletedk = deletedk + "[Konfiguration " & confnames(y) & "]:" & Chr(13)
For x = 0 To infocount - 1 ' Schleife durch alle konf. Eigenschaften
For z = 1 To infodelcount ' Schleife durch alle zu löschenden Eigenschaften
If infodel(z, 2) = "K" Then ' Abfrage ob es sich um eine konfigurat. Eig. handelt
If infodel(z, 1) = infonames(x) Then ' Falls die Eigenschaft in der Liste steht
retval = part.DeleteCustomInfo2(confnames(y), infonames(x)) ' Löschen der Eigenschaft
If retval = True Then ' Falls gelöscht wurde
deletedk = deletedk + infonames(x) + Chr(13) 'Speichern der Namen der gelöschten Eigenschaften
deletedcountk = deletedcountk + 1 ' Erfolgszähler + 1
End If
End If
End If
Next z
Next x
Next y
'### Bericht ###'
'msg = deletedcountb & " benutzerdefinierte Eigenschaften gelöscht:" & Chr(13) _
+ deletedb & Chr(13) & Chr(13) _
& deletedcountk & " konfigurationsspezifische Eigenschaften gelöscht:" & Chr(13) _
+ deletedk
'Dim f As New UserForm1
'f.TextBox1.MultiLine = True
'f.TextBox1.Text = msg
MsgBox deletedcountb & " benutzerdefinierte Eigenschaften gelöscht:" & Chr(13) _
+ deletedb & Chr(13) & Chr(13) _
& deletedcountk & " konfigurationsspezifische Eigenschaften gelöscht:" & Chr(13) _
+ deletedk
End If
Set part = Nothing
Set swApp = Nothing
End Sub
Foren auf CAD.de (alle Foren)
| 
