---

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 ...

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

[Diese Nachricht wurde von Michael Puschner am 19. Dez. 2011 editiert.]

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

---

Hallo

Laß mich raten, deine Zeichnung hat mehr als ein Blatt?!?!
Zeichnungsressourcen (Ränder und Schriftfelder lassen sich nur löschen, wenn sie auf keinem Blatt mehr eingefügt sind. Dein Script löscht aber nur auf dem aktuell aktiven Blatt. Das muß scheitern. Mein Glaskugel hält das jedenfalls für die wahrscheinlichste Ursache.
Wenn du nur das Schriftfeld des aktiven Blattes aus der Quellzeichnung in die Zielzeichnung kopierst ist es kein Wunder das nicht alle Schriftfelder kopiert werden. Hellsehen kann der Inventor nicht. 

Ansonsten kann es helfen die On Error Resume Next - Zeilen mal auszukommentieren und die Fehler zu provozieren. Dann kriegt man mal'ne Fehlermeldung. Nächster Schritt wäre ein schrittweises durchlaufen des Scriptes mit F8 im VBA-Editor und schauen an welcher Stelle es genau kracht.

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

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

---

ACHTUNG! Sie antworten auf einen Beitrag der älter als 1 Jahr ist!

Moin,

gibt es hierfür eine Erweiterung, dass er unsere derzeitigen Symbole und Ränder ersetzt. Er löscht im Moment einfach nur die Ränder raus, ersetzt sie aber nicht. Wahrscheinlich muss ich dort ja "ESM Rahmen" durch unsere Namen ersetzen, nur wir haben ja für jede Rahmengröße einen eigenen Namen und die Frage ist auch ob er unsere derzeitigen Rahmen mit dem gleichen Namen dann einfach ersetzen kann, genauso wie er es mit dem Schriftfeld tut. Bei den Symbolen soll praktisch das gleiche passieren.

Gruß
Marcus

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

---

Hallo bitte für mehr info unter folgendem Link schauen
http://ww3.cad.de/foren/ubb/Forum258/HTML/001363.shtml#000002

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

BlueJay

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