Habs geschafft..
---------------------------------------------------------------
Option Explicit
Sub main()
'Variablen definieren
Dim bearbeiter As String
Dim datum As String
Dim ersteller As String
Dim erstelldatum As String
'bearbeiter und datum Text zuweisen
bearbeiter = "Bearb. Name"
datum = "Bearb. Datum"
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
'Ist ein Dokument offen?
If swModel Is Nothing Then
MsgBox "Kein Dokument offen!", vbCritical
End
End If
'Ist Dokument eine Zeichnung?
If swModel.GetType <> swDocDRAWING Then
MsgBox "Dieses Makro funktioniert nur bei Zeichnungen!", vbCritical
End
End If
Dim swModelDocExtension As ModelDocExtension
Set swModelDocExtension = swModel.Extension
Dim swCustomPropertyManager As CustomPropertyManager
Set swCustomPropertyManager = swModelDocExtension.CustomPropertyManager("")
Dim wert1 As String
Dim wert2 As String
'Auslesen
wert1 = swCustomPropertyManager.Get(bearbeiter)
wert2 = swCustomPropertyManager.Get(datum)
Dim result_code As Integer
'Schreiben
result_code = swCustomPropertyManager.Add3("Ersteller", swCustomInfoType_e.swCustomInfoText, wert1, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
result_code = swCustomPropertyManager.Add3("Erstelldatum", swCustomInfoType_e.swCustomInfoText, wert2, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Dim boolstatus As Boolean
'Rebuild
boolstatus = swModel.ForceRebuild3(True)
End Sub
------------------
DW
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP