Hallo Leute ich konnte das Problem selbst lösen. Nun stelle ich die Lösung euch zur Verfügung.
Code:
________________________________________________________________________
Option Explicit
Dim swApp As Object
Dim Part As Object
Dim numConfigs As Long
Dim Names As Variant
Dim Retval As Boolean
Dim DelCount As Long
Dim InfoCount As Long
Dim InfoNames As Variant
Dim DelName As String
Dim Conf As Object
Dim ConfName As String
Dim ConfEinlesen As Long
Dim FirstConfName As String
Dim K As Integer
Dim i As Integer
'--------------------------------------------------------------------
Function CountString(SucheNach As String, SucheIn As String) As Long
Dim Position As Long
Dim WieOft As Long
Position = InStr(1, SucheIn, SucheNach)
Do While Position > 0
WieOft = WieOft + 1
Position = InStr(Position + Len(SucheNach), SucheIn, SucheNach)
If Position = 0 Then Exit Do
Loop
CountString = WieOft
End Function
'-------------------------------------------------------------------------------
Sub main()
Set swApp = GetObject(, "SldWorks.Application")
Set Part = swApp.ActiveDoc
If Not Part Is Nothing Then
If CountString("VC~~", Part.GetPathName) > 0 Then
InfoCount = Part.GetCustomInfoCount2("") ' wieviele Benutzerdef. Eigenschaften im akt. Teil?
InfoNames = Part.GetCustomInfoNames2("") ' Alle Namen der Benutzerdef. Eigenschaften in ein Variant einlesen
For K = 0 To InfoCount - 1 ' Schleife durch alle Benutzerdef. Eigenschaften
Retval = Part.DeleteCustomInfo2("", InfoNames(K)) ' Löschen aller Eigenschaften
Next K
numConfigs = Part.GetConfigurationCount()
Names = Part.GetConfigurationNames()
For i = 0 To numConfigs - 1 ' Schleife Durch alle Konfigurationen
'und nun erst mal die Konfigurationsspezifischen fieldNames auslesen
InfoCount = Part.GetCustomInfoCount2(Names(i)) ' wieviele konf. Eigenschaften in der akt. Konfiguration?
InfoNames = Part.GetCustomInfoNames2(Names(i)) ' Alle Namen der Konf. Eigenschaften in ein Variant einlesen
For K = 0 To InfoCount - 1 ' Schleife durch alle konf. Eigenschaften
Retval = Part.DeleteCustomInfo2(Names(i), InfoNames(K)) ' Löschen aller Eigenschaften
Next K
Next i
Else
MsgBox "Aktives Dokument ist nicht Virtuell !!"
End If
'MsgBox "Alle Dateieigenschaften sind gelöscht" vbNormal
End If
Set Part = Nothing
Set swApp = Nothing
End Sub
'-------------------------------------------------------------------
Viel spaß damit
------------------
Alles ist machbar, wenn man weis wie!
Selbständiger Konstrukteur
Für Kontakt E-Mail Adresse ins Gästebuch ablegen.
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP