Code:
Option ExplicitConst swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Public Enum swCustomInfoType_e
swCustomInfoUnknown = 0
swCustomInfoText = 30 ' VT_LPSTR
swCustomInfoDate = 64 ' VT_FILETIME
swCustomInfoNumber = 3 ' VT_I4
swCustomInfoYesOrNo = 11 ' VT_BOOL
End Enum
---
Sub main()
Dim swApp As Object
Dim ModelDoc As Object
Dim PropNames As New Collection
Dim Prop As Variant
Dim config As Variant
Dim ConfigCount As Long
Dim ConfigNames As Variant
Dim dummy As String
Dim Teilenamen, DateiName, BauteilNummer, DateiTyp, Bauteilname As String
Dim PosErstesLeerzeichen, LängeDateiname As Long
Set swApp = Application.SldWorks
Set ModelDoc = swApp.ActiveDoc
If ModelDoc Is Nothing Then
swApp.SendMsgToUser ("Keine Datei geöffnet! Makro beendet.")
Exit Sub
End If
DateiName = swApp.ActiveDoc.GetTitle
PosErstesLeerzeichen = InStr(DateiName, " ")
If PosErstesLeerzeichen = 0 Then
swApp.SendMsgToUser ("Dateiname ohne Leerzeichen! Makro beendet.")
Exit Sub
End If
LängeDateiname = Len(DateiName)
BauteilNummer = Left(DateiName, PosErstesLeerzeichen - 1)
DateiTyp = Right(DateiName, 6)
Bauteilname = Mid(DateiName, PosErstesLeerzeichen + 1, LängeDateiname - PosErstesLeerzeichen - 7)
If DateiTyp = "SLDDRW" Then
swApp.SendMsgToUser ("Dies ist eine Zeichnung! Makro beendet.")
Exit Sub
End If
Debug.Print ModelDoc.AddCustomInfo3(config, "Bauteil Nummer", swCustomInfoText, BauteilNummer)
Debug.Print ModelDoc.AddCustomInfo3(config, "Material", swCustomInfoText, Chr(34) & "SW-Material@" & ModelDoc.GetTitle & Chr(34))
Debug.Print ModelDoc.AddCustomInfo3(config, "Weight", swCustomInfoText, Chr(34) & "SW-Mass@" & ModelDoc.GetTitle & Chr(34))
If DateiTyp = "SLDPRT" Then
Debug.Print ModelDoc.AddCustomInfo3(config, "Bauteilname", swCustomInfoText, Bauteilname)
Debug.Print ModelDoc.AddCustomInfo3(config, "Baugruppenname", swCustomInfoText, "")
Else
Debug.Print ModelDoc.AddCustomInfo3(config, "Bauteilname", swCustomInfoText, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Baugruppenname", swCustomInfoText, Bauteilname)
End If
Debug.Print ModelDoc.AddCustomInfo3(config, "Konfigurationsbaugruppe", swCustomInfoYesOrNo, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Description", swCustomInfoText, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Fertigungsverfahren", swCustomInfoText, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Hersteller", swCustomInfoText, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Herstellernummer", swCustomInfoText, "")
Debug.Print ModelDoc.AddCustomInfo3(config, "Erstellt von", swCustomInfoText, Environ("USERNAME"))
Debug.Print ModelDoc.AddCustomInfo3(config, "Ersatzteil", swCustomInfoYesOrNo, "")
DateiinformationenÖffnen
End Sub
---
Sub DateiinformationenÖffnen()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Part.FileSummaryInfo
End Sub