---

Hallo WBF,

ich habe ein paar konkrete Fragen zur Erweiterung eines Plotmakros.

Folgende Dinge möchte ich in das bestehende Makro einfügen:

- plotuser (soll beim Ausdruck aktualisiert werden)
- Objektlinienstärken entfernen (damit der Toner gesparrt wird --> Green Makro )

Das Makro zum plotten habe ich dank des Forums und der Mitglieder (spezieller Dank an Schattenbacke fürs posten). In das Makro wurde weiterhin der Befehl zum aktualisieren des plotdatums eingebunden (in der idw als Benutzerdefinierter Iproperties).

Ich hoffe Ihr könnt mir helfen Üs sind schon reserviert

Hier der Code:

Sub KombiA3()
    PDF
    DruckenA3
End Sub
Sub KombiA4()
    PDF
    DruckenA4
End Sub
Public Sub PDF()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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 “SysDate”
    Dim NewDate As Date
    NewDate = Now
    Call Create_prop(oDrgDoc, "SysDate", NewDate)
    oDrgDoc.Update
   
        ' 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 = "PDFCreator"
   
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA2
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA1
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA0
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
   
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
        oDrgPrintMgr.SubmitPrint
        oDrgDoc.Save
    End If
End Sub
Public Sub DruckenA3()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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, "SysDate", NewDate)
    oDrgDoc.Update
   
        ' 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 e.g. "\\s001\MFP_KoBü" or assign another one
        oDrgPrintMgr.Printer = "\\s001\gelC5050"
   
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
   
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
        oDrgPrintMgr.SubmitPrint
        oDrgDoc.Save
    End If
End Sub
Public Sub DruckenA4()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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 “SysDate”
      Dim NewDate As Date
    NewDate = Now
    Call Create_prop(oDrgDoc, "SysDate", NewDate)
    oDrgDoc.Update
   
        ' 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 = "\\s001\gelC5050"
   
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
   
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
      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

Vielen Dank!

Gruß

Sepp

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Teste mal:

Code:

---

Option Explicit

Sub KombiA3()
    PDF
    DruckenA3
End Sub
Sub KombiA4()
    PDF
    DruckenA4
End Sub
Public Sub PDF()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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 “SysDate”
    Dim NewDate As Date
    NewDate = Now
    Call Create_prop(oDrgDoc, "SysDate", NewDate)
   
    'Aktuellen Benutzer auslesen und iProp "plotuser" erstellen
    Dim PlotUser As String
    PlotUser = ThisApplication.UserName 'liest den Benutzernamen aus den Inventor Anwendungsoptionen aus, nicht den Windowsbenutzernamen!!!
    Call Create_prop2(oDrgDoc, "PlotUser", PlotUser)
   
    oDrgDoc.Update
 
        ' 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 = "PDFCreator"
 
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA2
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA1
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA0
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
 
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
       
        'Linienstärke entfernen
        oDrgPrintMgr.RemoveLineWeights = True
       
        oDrgPrintMgr.SubmitPrint
        oDrgDoc.Save
    End If
End Sub
Public Sub DruckenA3()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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, "SysDate", NewDate)
   
    'Aktuellen Benutzer auslesen und iProp "plotuser" erstellen
    Dim PlotUser As String
    PlotUser = ThisApplication.UserName 'liest den Benutzernamen aus den Inventor Anwendungsoptionen aus, nicht den Windowsbenutzernamen!!!
    Call Create_prop2(oDrgDoc, "PlotUser", PlotUser)
   
    oDrgDoc.Update
 
        ' 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 e.g. "\\s001\MFP_KoBü" or assign another one
        oDrgPrintMgr.Printer = "\\s001\gelC5050"
 
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA3
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
 
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
       
        'Linienstärke entfernen
        oDrgPrintMgr.RemoveLineWeights = True
       
        oDrgPrintMgr.SubmitPrint
        oDrgDoc.Save
    End If
End Sub
Public Sub DruckenA4()
    'Print all sheets in drawing document
    'Get the active document and check whether it's 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 “SysDate”
      Dim NewDate As Date
    NewDate = Now
    Call Create_prop(oDrgDoc, "SysDate", NewDate)
   
    'Aktuellen Benutzer auslesen und iProp "plotuser" erstellen
    Dim PlotUser As String
    PlotUser = ThisApplication.UserName 'liest den Benutzernamen aus den Inventor Anwendungsoptionen aus, nicht den Windowsbenutzernamen!!!
    Call Create_prop2(oDrgDoc, "PlotUser", PlotUser)
   
    oDrgDoc.Update
 
        ' 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 = "\\s001\gelC5050"
 
        oDrgPrintMgr.PrintRange = kPrintAllSheets
        'Set the paper size and scale
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Size
            Case kA4DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
                oDrgPrintMgr.[Scale] = 1
            Case kA3DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA2DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA1DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
                'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case kA0DrawingSheetSize
                oDrgPrintMgr.PaperSize = kPaperSizeA4
              'oDrgPrintMgr.ScaleMode = kPrintCustomScale
                oDrgPrintMgr.ScaleMode = kPrintBestFitScale
            Case Else    ' Andere Werte.
                Debug.Print "ungültiges Papierformat"
        End Select
 
        'Set the paper orientation
        On Error Resume Next
        Select Case oDrgDoc.ActiveSheet.Orientation
            Case kLandscapePageOrientation
                oDrgPrintMgr.Orientation = kLandscapeOrientation
            Case kPortraitPageOrientation
                oDrgPrintMgr.Orientation = kPortraitOrientation
            Case Else    ' Andere Werte.
                Debug.Print "ungültige Orientierung"
        End Select
       
        'Linienstärke entfernen
        oDrgPrintMgr.RemoveLineWeights = True
       
      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

Sub Create_prop2(oDoc As Document, prop As String, prop_value As String)
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

---

------------------
MfG
RK

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Super vielen Dank rkauskh,

das hilft mir total weiter. Bei mir steht zwar der User Admin, aber ich werde es mal auf den anderen Rechnern testen.

Vielen Dank für Deine Antwort, Üs sind unterwegs!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Geh im Inventor unter "Extras", "Anwendungsoptionen" auf die Registerkarte "Allgemein" und das was dort oben rechts als Benutzername steht wird ausgelesen. Müßtet ihr halt mal bei euren Rechnern korrekt einstellen.

------------------
MfG
RK

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP