Hallo liebe Gemeinde,
Ich würde mal wieder eure Hilfe benötigen.
Ich habe ein Makro, dass mir den Dateinamen nach dem Schema "Materialnummer - Bezeichnung.sldxxx" (z.B. 0123-00-001A - Grundrahmen.sldprt) in Materialnummer und Bezeichnung auftrennt und diese Werte in den Dateieigenschaften als Benutzerdefiniert anlegt (z.B. Materialnummer(als Text) / 01232-00-001A & Bezeichnung(als Text) / Grundrahmen). So weit so gut.
Jetzt möchte ich diese Werte nicht als benutzerdefiniert anlegen lassen sondern als Konfigurationsspezifisch.
Kann mir bitte jemand meinen Code anpassen oder mir sagen was ich ändern muss um dies zu erreichen?
habe versuchsweise die "swCustomInfoType_e.swCustomInfoText" in "swConfigInfoType_e.swCustomInfoText" geändert. Hat leider nicht funktioniert 
.
Habe keine Ahnung von API. Immer nur dry and error .... 
Vielen dank schon mal.
lg
gearloose
############################################################################################
'******************************************************************************
'*** Diese Makro zerlegt den Dateinamen in Materialnummer und Bezeichnung
'*** und schreibt diese Werte in die Dateieigenschaften
'******************************************************************************
Dim swApp As SldWorks.ISldWorks
Dim swModelDoc As SldWorks.IModelDoc2
Dim swDrawDoc As SldWorks.IDrawingDoc
Dim cusPropMgr As SldWorks.ICustomPropertyManager
Public Sub SplitProperties()
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
If (swModelDoc.GetType = swDocDRAWING) Then
swApp.SendMsgToUser ("Funtioniert nicht bei Zeichnungen!")
Else
' Set swDrawDoc = swModelDoc
Set swModelDoc = swApp.ActiveDoc
'Anzeigenamen holen
Dim HauptnameLang As String
Dim Hauptname As String
Dim Bauteilnummer As String
Dim Bezeichnung1 As String
Dim UnterstrichPos As Integer
Dim BindestrichPos As Integer
Dim PunktPos As Integer
' HauptnameLang = swModelDoc.GetTitle
HauptnameLang = swModelDoc.GetPathName
For i = Len(HauptnameLang) To 1 Step -1
If Mid(HauptnameLang, i, 1) = "\" Then
Hauptname = Mid(HauptnameLang, i + 1, Len(HauptnameLang) - i - 7)
Exit For
End If
Next i
' MsgBox (Hauptname)
' Debug.Print "Hauptname: " & Hauptname
'Bauteilnummer extrahieren
UnterstrichPos = VBA.InStr(1, Hauptname, " - ")
If UnterstrichPos = 0 Then
swApp.SendMsgToUser ("Dateiname muss nach der Materialnummer "" - "" enthalten!")
Exit Sub
End If
Bauteilnummer = VBA.Left(Hauptname, UnterstrichPos - 1)
'Bezeichnung 1 extrahieren
Bezeichnung1 = VBA.Mid(Hauptname, UnterstrichPos + 3)
'In benutzerdefinierte Eigenschaften eintragen (Felder: Materialnummer, Bezeichnung)
Set cusPropMgr = swModelDoc.Extension.CustomPropertyManager("")
cusPropMgr.Add3 "Materialnummer", swCustomInfoType_e.swCustomInfoText, Bauteilnummer, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd
cusPropMgr.Add3 "Bezeichnung", swCustomInfoType_e.swCustomInfoText, Bezeichnung1, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd
'Neuaufbau
swModelDoc.ForceRebuild3 True
End If
End Sub
#####################################################################
edit: Es ist immer nur eine (1) Konfiguration enthalten mit dem Namen "Standard". Ist glaub ich wichtig und macht das vermutlich einfacher .. 
lG
[Diese Nachricht wurde von gearloose7 am 24. Aug. 2023 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de
| 
