Plotdatum in Schriftkopf und Zeichnung automatisch drucken

Dieses Makro füllt das Benutzer-iProperty “plotdate” aus und druckt die Zeichnung anschließend automatisch auf A4 und dem Windows-Standarddrucker aus . Damit das Plotdatum auch im Schriftkopf steht, muss in der Vorlage ein Benutzer-iProperty “plotdate” angelegt…

und im Schriftkopf platziert werden.

Nun das Makro in die Default.ivb einfügen (ALT+F11 drücken und den Macrotext in das Modul des default.ivb Projektes einfügen)

und das Icon anschließend in der Oberfläche platziert werden. Dazu auf Extras > Anpassen gehen und in der Dialogbox in das Register “Befehle” wechseln und dort unter Kategorie den Befehl “PlotDateinDrawing” in die Oberfläche ziehen.

Hier das Makro in einer TXT-Datei und so sieht es aus:

Option Explicit
Public Sub PlotDateInDrawing()
‘Print all sheets in drawing document
‘Get the active document and check whether it’s a drawing document
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
‘Find the current date and assign it to a property called “plotdate”
Dim NewDate As Date
NewDate = Now
Call Create_prop(oDrgDoc, “plotdate”, NewDate)
‘ Set reference to drawing print manager
‘ DrawingPrintManager has more options than PrintManager
‘ as it’s specific to drawing document
Dim oDrgPrintMgr As DrawingPrintManager
Set oDrgPrintMgr = oDrgDoc.PrintManager
‘ Set the printer name
‘ comment this line to use default printer or assign another one
‘oDrgPrintMgr.Printer = “HP LaserJet 4000 Series PCL 6″
‘Set the paper size , scale and orientation
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
‘oDrgPrintMgr.ScaleMode = kPrintCurrentWindow
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.PrintRange = kPrintAllSheets
oDrgPrintMgr.SubmitPrint
oDrgDoc.Save
End If
End Sub

Sub Create_prop(oDoc As Document, prop As String, prop_value As Date)
Dim oPropSets As PropertySets
Dim opropset As PropertySet
Dim oUserPropertySet As PropertySet
Dim i As Integer
Set oPropSets = oDoc.PropertySets
For Each opropset In oPropSets
If opropset.Name = “Inventor User Defined Properties” Then Set oUserPropertySet = opropset
Next opropset
‘ If Property does not exist then add the new Property
On Error Resume Next
Call oUserPropertySet.Add(prop_value, prop)
‘ Try to set the Property value if it already exists
For i = 1 To oUserPropertySet.Count
If oUserPropertySet.Item(i).Name = prop Then oUserPropertySet.Item(i).Value = prop_value
Next i
End Sub