---

Hallo zusammen,
wer von euch kann mir mit einer kleinen VBA Anpassung helfen - bin blutiger VBA Anfänger und habe mir folgenden Code schon hier aus dem Forum besorgt und versucht an meine Bedürfnisse anzupassen.

Der Code tauscht Symbole und Rahmen/Schriftfelder aus einer bestehenden Zeichnung mir der einer Vorlage aus - Mein Problem bis jetzt kopierte er alles auch gut aus der Vorlage in die bestehende Datei - überschreibt aber nicht die schon vorhandenen - er erstellt aus noch mal kopien der einzelnen elemente?

Hier mal der code

Sub Schriftfeld() ' ersetzt das Schriftfeld in der aktuellen Zeichnung durch ein neues (Position siehe **)
If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
  Dim ZielDoc As DrawingDocument
  Set ZielDoc = ThisApplication.ActiveDocument
  Dim Blatt As Sheet
  Set Blatt = ZielDoc.ActiveSheet
  Dim i, j As Integer
  Dim zahl1 As Long
  'vorhandenen Rahmen löschen
  On Error Resume Next
  Blatt.Border.Delete
  j = ZielDoc.BorderDefinitions.Count
  For i = 1 To j
  ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete
  Next
  'löscht vorhandene skizzierte Symbole
  zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
  Next
  Dim oSketchedSymbolDef As SketchedSymbolDefinition
  Dim QuellDoc As DrawingDocument
  Set QuellDoc = ThisApplication.Documents.Open("\\gainserver\gain\GAIN\Iface\Inventor\Templates\R15\Norm.idw") '**
  Dim QuellRahmen As BorderDefinition
  Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Rahmen")
  Dim ZielRahmen As BorderDefinition
  Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc)
  Dim QuellSchriftfeld As TitleBlockDefinition
  Set QuellSchriftfeld = QuellDoc.ActiveSheet.TitleBlock.Definition
  Dim ZielSchriftfeld As TitleBlockDefinition
  Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc)
  'fügt neue skizzierte Symbole aus Vorlagedatei ein
  zahl1 = QuellDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc, True)
  Next
  QuellDoc.Close
  'fügt Zeichnungsrahmen ins Blatt ein
  Call Blatt.AddBorder(ZielRahmen)
  'fügt neues Schriftfeld in Zeichnung ein
  Blatt.TitleBlock.Delete
  Call Blatt.AddTitleBlock(ZielSchriftfeld)
  'schaltet Browserleiste wieder ein
  ThisApplication.UserInterfaceManager.ShowBrowser = True
Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
End If
End Sub

Würde mich über alle Hilfen sehr freuen

Vielen Dank schon mal

MFG

------------------
MFG

BlueJay

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

---

Hallo Bluejay,

den Übertragungsassistent für Zeichnungsressourcen kennst du?
Dan kannst du ja diese Dinge recht einfach austauschen, ohne jede Zeichnung öffnen zu müssen.

------------------
Gruß, Gandhi
It's not a bug, it's a feature!
CAD-RPG - Anleitungen IVNGWC

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

---

Danke erstmal - das hört sich gut an - werde mir die Sache mit dem Übertragungsassistent für Zeichnungsressourcen mal anschauen

Danke noch mal

MFG

------------------
MFG

BlueJay

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

---

Guten Morgen zusammen,
ich muss noch einmal meine alte Frage aufgreifen und hoffe das mir jemand mit meinem Problem helfen kann.

Und zwar möchte ich gerne mit einem VBA die gesamten Zeichnungsresourcen von einer Vorlage in die Active Zeichnung kopieren.

Das VBA funktioniert mit dem folgendeb Code auch schon ganz gut - aber es löscht nicht alle bestehenden Schriftfelder aus den Zeichnungsresourcen der activen Zeichung und kopiert nich alle neuen Schriftfelder aus der Template in die Zeichung bzw. dessen Zeichungsresourcen.

Sub Schriftfeld() ' ersetzt das Schriftfeld in der aktuellen Zeichnung durch ein neues (Position siehe **)
If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
  Dim ZielDoc As DrawingDocument
  Set ZielDoc = ThisApplication.ActiveDocument
  Dim Blatt As Sheet
  Set Blatt = ZielDoc.ActiveSheet
  Dim i, j As Integer
  Dim zahl1 As Long
  Dim zahl2 As Long
  'vorhandenen Rahmen löschen
  On Error Resume Next
  Blatt.Border.Delete
  j = ZielDoc.BorderDefinitions.Count
  For i = 1 To j
  ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete
  Next
    'vorhandenen Schriftfelder löschen
  On Error Resume Next
  Title.Block.Delete
  j = ZielDoc.TitleBlockDefinition.Count
  For i = 1 To j
  ZielDoc.TitleBlockDefinition.Item(j + 1 - i).Delete
  Next
  'vorhandene skizzierte Symbole löschen
  zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
  Next
  Dim oSketchedSymbolDef As SketchedSymbolDefinition
  Dim QuellDoc As DrawingDocument
  Set QuellDoc = ThisApplication.Documents.Open("\\gainserver\gain\GAIN\Iface\Inventor\Templates\R15\Norm.idw") '**
  Dim QuellRahmen As BorderDefinition
  Set QuellRahmen = QuellDoc.BorderDefinitions.Item("ESM Rahmen")
  Dim ZielRahmen As BorderDefinition
  Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc, True)
  Dim QuellSchriftfeld As TitleBlockDefinition
  Set QuellSchriftfeld = QuellDoc.ActiveSheet.TitleBlock.Definition
  Dim ZielSchriftfeld As TitleBlockDefinition
  Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc, True)
  'fügt neue skizzierte Symbole aus Vorlagedatei ein
  zahl1 = QuellDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc)
  Next
  QuellDoc.Close
  'fügt Zeichnungsrahmen ins Blatt ein
  Call Blatt.AddBorder(ZielRahmen)
  'fügt neues Schriftfeld in Zeichnung ein
  Blatt.TitleBlock.Delete
  Call Blatt.AddTitleBlock(ZielSchriftfeld)
  'schaltet Browserleiste wieder ein
  ThisApplication.UserInterfaceManager.ShowBrowser = True
Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
End If
End Sub

Kann mir jemand mit dieser Aufgabe helfen?
Vielen Dank

MFG

------------------
MFG

BlueJay

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

---

Zitat:

---

Original erstellt von Bluejay:
... Kann mir jemand mit dieser Aufgabe helfen? ...

---

Die beste Hilfe hierzu erhält man sicherlich im richtigen Forum.

Für Diskussionen über IV-VBA gibt es ein eigenes Forum: Inventor VBA

Dorthin werde ich diesen Thread jetzt auch verschieben ...

... hier geht es dann weiter.

------------------
Michael Puschner
Autodesk Inventor Certified Expert
Mensch und Maschine Scholle GmbH

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