---

Hallo Zusammen,
ich habe eine kleine Frage und zwar beschäftige ich mich noch immer mit dem unten aufgeführten Makro - ich bin ein Anfäger in diesem Bereich und würde mich über jede Unterstützung freuen.

Was ich erreichen zu versuche - die gesamten Zeichnungsresourcen in der activen Zeichnung  mit denen der Vorlage abzugleichen.
Ziel:
1. Rahmen, Schriftfeld aus Zeichnung löschen
2. Kopieren von den gesamten Resourcen aus Vorlage in die Resourcen der activen Zeichnung (Symbole die auf der Zeichnug sind und nicht aus den    REsourcen gelöscht worden sind - nicht noch mal als Kopie anlegen?!)
3. Einfügen von Rahmen, Schriftfeld in active Zeichnung
4. Fertig

Hat jemand eine Idee - bitte mit Erklärung damit ich weiter lernen kann

Vielen Dank schon mal

Sub Zeichnungsresourcen()
'ersetzt die Zeichnungsresourben in der aktuellen Zeichnung durch die der Template

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 Blattformate löschen (Step#1)
  zahl1 = ZielDoc.SheetFormats.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.SheetFormats.Item(zahl1 + 1 - i).Delete
  Next

'vorhandenen Rahmen löschen (Step#1)
  On Error Resume Next
  Blatt.Border.Delete
  j = ZielDoc.BorderDefinitions.Count
  For i = 1 To j
  ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete
  Next
 
  zahl1 = ZielDoc.BorderDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.BorderDefinitions.Item(zahl1 + 1 - i).Delete
  Next
 
'vorhandenen Schriftfelder löschen (Step#2)
  On Error Resume Next
  Title.Block.Delete
  j = ZielDoc.TitleBlockDefinition.Count
  For i = 1 To j
  ZielDoc.TitleBlockDefinition.Item(j + 1 - i).Delete
  Next

  zahl1 = ZielDoc.TitleBlockDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.TitleBlockDefinitions.Item(zahl1 + 1 - i).Delete
  Next

'vorhandene skizzierte Symbole löschen (Step#4)
  zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
  Next

'Resourcen der Template defenieren (Step#5)
  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.TitleBlockDefinitions.Item("ESM DE")
  Dim ZielSchriftfeld As TitleBlockDefinition
  Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc, True)

 
'fügt neue skizzierte Symbole aus Template in Actives Blatt ein(Step#6)
  Blatt.SketchedSymbolDefinition.Delete
  zahl1 = QuellDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc)
  Next
  QuellDoc.Close

'fügt Zeichnungsrahmen ins Active Blatt ein (Step#7)
  Call Blatt.AddBorder(ZielRahmen)
 
 
'fügt neues Schriftfeld in Active Blatt ein(Step#8)
  Blatt.TitleBlock.Delete
  Call Blatt.AddTitleBlock(ZielSchriftfeld)

'schaltet Browserleiste wieder ein (Step#8)
  ThisApplication.UserInterfaceManager.ShowBrowser = True
Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
End If
End Sub

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

BlueJay

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

---

Hi

Hab's nicht ausprobiert, aber wo in deinem Code ist das Problem? Sollen wir jetzt alle ein Testszenario bauen und solange rumprobieren bis wir auf einen Fehler stoßen? Gib uns doch bitte ein konkretes Problem.

Das einzige was ich so auf Anhieb sehe ist Step 6 - die skizzierten Symboldefinitionen werden nicht ins aktive Blatt, sondern nur in die Ressourcen kopiert. Vermutlich ist da aber nur der Kommentar falsch formuliert.

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

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

---

Hallo zusammen und Danke für alle Antworten,
anbei das fertige Makro mit dem ich nun alle Zeichnungsresourcen aus der Vorlage in die Aktive Zeichnung kopieren kann.

Vielleicht kann es ja jemand brauchen!

Sub Zeichnungsresourcen()
'ersetzt die Zeichnungsresourben in der aktuellen Zeichnung durch die der Template

  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 Blattformate aus activer Zeichnungsresource löschen (Step#1)
  zahl1 = ZielDoc.SheetFormats.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.SheetFormats.Item(zahl1 + 1 - i).Delete
  Next

'vorhandenes Schriftfeld aus activer Zeichnung löschen (Step#2)
  On Error Resume Next
  Blatt.TitleBlock.Delete
  zahl1 = ZielDoc.TitleBlockDefinitions.Count
  For i = 1 To zahl1
  On Error Resume Next
  ZielDoc.TitleBlockDefinitions.Item(zahl1 + 1 - i).Delete
  Next
 
'vorhandenen Rahmen aus activer Zeichnungsresource löschen (Step#3)
  On Error Resume Next
  Blatt.Border.Delete
  j = ZielDoc.BorderDefinitions.Count
  For i = 1 To j
  ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete
  Next
 
'vorhandene skizzierte Symbole löschen (Step#4)
  On Error Resume Next
  Blatt.SketchedSymbolDefinition.Delete
  zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
  For i = 1 To zahl1
  ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
  Next

'Resourcen der Template defenieren und Kopieren(Step#5)
  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.TitleBlockDefinitions.Item("ESM DE")
  Dim ZielSchriftfeld As TitleBlockDefinition
  Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc, True)

'fügt neue skizzierte Symbole aus Template in die Zeichnungsresourcen des activen Blattes ein(Step#6)
  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 Active Blatt ein (Step#7)
  Call Blatt.AddBorder(ZielRahmen)
 
'fügt neues Schriftfeld in Active Blatt ein(Step#8)
  Call Blatt.AddTitleBlock(ZielSchriftfeld)

'schaltet Browserleiste wieder ein (Step#9)
  ThisApplication.UserInterfaceManager.ShowBrowser = True
  Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
  End If
End Sub

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

BlueJay

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