---

Guten Tag,
ich suche ein Makro, womit ich eine alte Zeichnung mit meiner neuen Zeichnungsvorlage abgleichen und aktualisieren kann.
Sprich alle Stile, Zeichnungsrahmen, Schriftfeld usw.

Gibt es sowas?

Vielen Dank im Voraus!

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

---

Moin

Es gibt den Übertragungsassistenten für Zeichnungsressourcen als Standardfunktion von Inventor. Schau mal in deinem Startmenü. Damit können Schriftfelder, Rahmen und auch skizzierte Symbole übertragen werden. Bei Namensgleichheit kann man mW wählen, ob die vorhandenen ersetzt werden sollen. Die Stile werden üblicherweise über die Stilbibliothek aktualisiert. Stile aus neuer Vorlage in Biliothek speichern, alte Zeichnung öffnen und Stile aktualisieren lassen.

Oder reden wir von einer "Aktualisierung" die eher ein Austausch ist?

------------------
MfG
Ralf

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

---

Hi,

etwas in der Art habe ich in Verwendung: Schriftfeld aus der Vorlage in das aktive Blatt einfügen bzw. vorhandenes ersetzen. Stile aktualisieren. Unten der Code dazu.

Rahmen habe ich bisher nicht. Vermutlich ließe sich das Vorgehen beim Schriftfeld auch dafür anwenden.

Code:

---

Option Explicit

Const sIDW_titleblock As String = "Schriftfeld-Name"  'Name des Schriftfeldes
Const sIDW_Vorlage As String = "C:\...\Templates\Standard.idw"  'Pfad und Dateiname der Vorlage
' ### Name & Pfad anpassen! ###
'

Public Sub UpdateIDW()

    'nur für Zg./IDW
    If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
        MsgBox "nur für idw!", vbInformation, "abgebrochen"
        Exit Sub
    End If
   
    'aktives Dokument
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    'Schriftfeld aktualisieren
    Call Schriftfeld_Update
   
    'unbenutzte Schriftfelder löschen
    Call idw_DelUnusedTitleBlocks(oDoc)
   
    'Stile aktualisieren
    Call idw_UpdateStyles(oDoc, True)  'True: unbenutzte Stile werden gelöscht
   
    'Vault-Revisionstabelle einfügen
    ' Call idw_InsertVaultRevTable  'könnte ich ggf. nachliefern
   
End Sub

Private Sub Schriftfeld_Update()
' in der aktiven Zg./aktivem Blatt wird das Schriftfeld ersetzt
' durch das aktuelle aus der Vorlage
'
' KraBBy 09.03.2020
   
    'aktives Dokument
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    ' [dieses Sub war mal eigenständig, deshalb wird oDoc nicht vom aufrufenden Sub übergeben ]
   
    ' Den Ablauf in eine einzige Rückgängig-Aktion packen
    Dim oTxnMgr As TransactionManager
    Set oTxnMgr = ThisApplication.TransactionManager
    Dim oTxn As Transaction
   
    'Start oTxn
    Set oTxn = oTxnMgr.StartTransaction(ThisApplication.ActiveDocument, "Makro 'Schriftfeld_Update'")  'Namen ggf. aktualisieren!
   
    'Schriftfeld Definition aus Vorlage
    ' dabei wird die evtl. vorhandene gleichnamige Def. überschrieben
    Dim oNewTitleBlockDef As TitleBlockDefinition
    Set oNewTitleBlockDef = TitleBl_aus_Template(oDoc, sIDW_titleblock) 'Aufruf der Func unten
   
    'falls Schriftfeld in der Vorlage nicht vorhanden ist, Abbruch
    If oNewTitleBlockDef Is Nothing Then
        oTxn.Abort
        MsgBox "In der Vorlage gibt es kein Schriftfeld mit diesem Namen:" & vbCrLf _
                & sIDW_titleblock, vbCritical, "Makro abgebrochen"
        Exit Sub
    End If
   
    'Schriftfeld ggf. ersetzen
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
    'For Each oSheet In oDoc.Sheets    'Schleife auskommentiert -> nur aktives Blatt
        'oSheet.Activate
        If oSheet.TitleBlock Is Nothing Then    'kein Schriftfeld
            Call oSheet.AddTitleBlock(oNewTitleBlockDef)    ' neues einfügen
        ElseIf Not oSheet.TitleBlock.Name = sIDW_titleblock Then
            oSheet.TitleBlock.Delete    'Schriftfeld löschen
            Call oSheet.AddTitleBlock(oNewTitleBlockDef)    ' neues einfügen
        Else 'richtiges Schriftfeld vorhanden
            ' nix tun
            ' (Definition wurde schon aktualisiert)
        End If
    'Next
   
    'Rückgängig-Aktion abschließen
    oTxn.End
   
    'Aufräumen
    Set oDoc = Nothing
    Set oNewTitleBlockDef = Nothing
    Set oSheet = Nothing
    Set oTxnMgr = Nothing
    Set oTxn = Nothing
   
End Sub

Private Function TitleBl_aus_Template(oIdw As DrawingDocument, sTitleName As String) As TitleBlockDefinition
' fügt eine TitleBlockDefinition (Schriftfeld) in eine idw ein
' sollte gleichnamige Definition bereits vorh sein, wird überschrieben -> kann also ggf. auch zum Aktualsieren genutzt werden
'
' oIDW          : Zg.Document in das das Symbol eingefügt wird
' sTitleName    : Name des Schriftfeldes
'
' KraBBy 09.03.2020
   
    'neue idw aus Vorlage öffnen
    Dim oVorlage As DrawingDocument
    Set oVorlage = ThisApplication.Documents.Add(kDrawingDocumentObject, sIDW_Vorlage, False) 'Visible = False
   
    'Symb.Def finden
    Dim oTitleBlDef As TitleBlockDefinition
    On Error Resume Next
    Set oTitleBlDef = oVorlage.TitleBlockDefinitions.Item(sTitleName)
   
    If 0 = Err.Number And Not oTitleBlDef Is Nothing Then
        'Symb gefunden
        On Error GoTo 0
        'kopieren
        Set TitleBl_aus_Template = oTitleBlDef.CopyTo(oIdw, True)    'Rückgabewert
            'dabei ReplaceExisting = True
    Else
        'Schriftfeld mit dem Namen nicht vorhanden
        On Error GoTo 0
        Set TitleBl_aus_Template = Nothing      'Rückgabewert
    End If
   
    'Vorlage schließen
    oVorlage.Close (True)
   
    'Aufräumen
    Set oVorlage = Nothing
    Set oTitleBlDef = Nothing
End Function

Private Sub idw_DelUnusedTitleBlocks(oDoc As DrawingDocument)
'löscht alle unbenutzten Schriftfeld-Definitionen aus den Zg.Ressourcen
' KraBBy 18.12.2020
   
   
    ' Den Ablauf in eine einzige Rückgängig-Aktion packen
    Dim oTxnMgr As TransactionManager
    Set oTxnMgr = ThisApplication.TransactionManager
    Dim oTxn As Transaction
    'Start oTxn
    Set oTxn = oTxnMgr.StartTransaction(ThisApplication.ActiveDocument, "Makro 'unbenutzte Schriftfelder löschen'")
   
   
    Dim oTBl As TitleBlockDefinition, i As Integer
    For i = oDoc.TitleBlockDefinitions.Count To 1 Step -1
    'For Each oTBl In oDoc.TitleBlockDefinitions 'wollte vermeiden, über die Collection zu iterieren, und dabei elemente zu löschen
        Set oTBl = oDoc.TitleBlockDefinitions.Item(i)
        If Not oTBl.IsReferenced Then oTBl.Delete
    Next
   
    'Rückgängig-Aktion abschließen
    oTxn.End
           
    'Aufräumen
    Set oTxnMgr = Nothing
    Set oTxn = Nothing
End Sub

Private Sub idw_UpdateStyles(oDoc As DrawingDocument, bDelUnusedStyles As Boolean)
'gleicht die lokalen Stile mit den Globalen ab und löscht nicht benutzte
'
'  oDoc        : Zeichnung / idw, die aktualisiert wird
'  bDelUnusedStyles    : Wenn True, werden unbenutzte Stile gelöscht
'
' KraBBy 18.12.2020
   
    ' Den Ablauf in eine einzige Rückgängig-Aktion packen
    Dim oTxnMgr As TransactionManager
    Set oTxnMgr = ThisApplication.TransactionManager
    Dim oTxn As Transaction
   
    'Start oTxn
    Set oTxn = oTxnMgr.StartTransaction(ThisApplication.ActiveDocument, "Makro 'Update_Stile'")
   
    Dim oStyle As Style
    For Each oStyle In oDoc.StylesManager.Styles
        If oStyle.StyleLocation = kBothStyleLocation Then
            If Not oStyle.UpToDate Then oStyle.UpdateFromGlobal
            If Not oStyle.InUse And bDelUnusedStyles Then Stop: oStyle.Delete
        End If
    Next
   
    'Rückgängig-Aktion abschließen
    oTxn.End
       
    'Aufräumen
    Set oTxnMgr = Nothing
    Set oTxn = Nothing
   
End Sub

---

------------------
Gruß KraBBy

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

---

HI,
vielen Dank für die Lösung.
Das Schriftfeld aktualisieren klappt wunderbar.

Aber leider werden die Stile nicht von der Vorlage idw auf die aktuelle idw übertragen.

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

---

Hi,
danke für deine Antowrt.
Genau, es soll ein Austausch der idw Vorlage mit der aktuellen Zeichnung sein.

Gruß

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

---

Zitat:

---

Original erstellt von Tommy174:
Aber leider werden die Stile nicht von der Vorlage idw auf die aktuelle idw übertragen.

---

Richtig. Es werden die Stile der aktuellen idw mit jenen in der Bibliothek abgeglichen und ggf. aktualisiert. Das sollte dem entsprechen, was durch den Befehl auf der GUI "Stile aktualisieren" passiert. Hilfe, Aktualisieren von Stilen

Ich denke, es ist so gedacht vom Erfinder, dass Stile der Vorlage und Bibliothek gleich sind. Es gibt eine Warnmeldung, falls das nicht der Fall ist.

Nun ist es bei Dir scheinbar nicht so. 
Kannst Du die Bib auf den Stand der Vorlage bringen? (würde ich zu Fuß machen, aber es gibt den Befehl auch in der API)
Wie machst Du das aktuell, Stile aus einer idw in eine andere zu bringen?

------------------
Gruß KraBBy

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

---

Aktuell lösche ich alten Zeichnungen und erstelle sie mit der Vorlage neu     
Deswegen wäre so ein one klick sehr hilfreich.

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

---

Aha... Die Frage nach der Bib?

Was ist mit dem Rahmen? Bekommst du das selbst programmiert?

------------------
Gruß KraBBy

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

---

Nochmal zur Verständnis, ich habe eine neue Vorlage auf dem Server liegen. Nach dieser Vorlage werden aktuellen Zeichnungen erstellt.
Ich habe aber noch viele alte Zeichnungen im System, wo die Stile Rahmen Schriftfeld veraltet sind.

Was ich aktuell mache ist, eine neue Zeichnung erstellen und das Blatt aus der veralteten Zeichnung kopieren und in die neue Vorlage einfügen.

Ich dachte, vielleicht gibt es schon so ein Makro für diesen Fall.
Und nein ich kann selber keine Markos schreiben. Einfügen in den VBA Editor klappt. 

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

---

Hi, ich versuche es nochmal in möglichst kleinen Schritten.

• Ralf hat den Übertragungsassistenten genannt. Hast Du das ausprobiert? Kann der das gewünschte erreichen?
  
• Kannst Du die Stil-Bibliothek auf den Stand der Vorlage bringen?
• hier sollte viel Information dazu vorhanden sein ... RTFM
  
• Zeichnungsrahmen: Sind die Namen zwischen alt und neu gleich? Ist es ausreichend, einfach nur alle Rahmen der Vorlage in die Zg.Ressourcen zu kopieren? btw. das geht übrigens auch zu Fuß mit Kopieren/Einfügen.
  
• (angenommen das mit den Stilen wäre gelöst und auch jemand hätte eine Lösung für den Zeichnungsrahmen programmiert) Gibt es noch etwas, das übertragen werden muss?
  skizzierte Symbole? Blattformate?

------------------
Gruß KraBBy

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

---

Rahmen2.png

Hallo Krabby,

ich habe jetzt die Stile von meiner Vorlage in die Biblio übertragen.
Hat super geklappt.
Jetzt fehlen nur noch die Zeichnungsrahmen. Die Namen können unterschiedlich sein. Es würde reichen wenn die aktuellen gelöscht werden und die neuen aus der Vorlage kopiert werden.
Die Blattformate und die Skizziersymbole sollten auch übertragen werden.

Ich habe das was gefunden, vielleicht kann man davon etwas übernehmen.

https://ww3.cad.de/foren/ubb/Forum258/HTML/001363.shtml#000002

[Diese Nachricht wurde von Tommy174 am 03. Feb. 2026 editiert.]

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