---

Guten Tag zusammen,
Fals es jemand braucht ein Makro das die Zeichnungsresourcen(Rahmen, Symbole usw) und die Stilbiliothek mit einer Vorlage Datei bzw mit der globalen Stilbibliotek abgleicht und die nicht verwendete Stile löscht.

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("Hier Pfad der Vorlagedatei eingeben")
 
  Dim QuellRahmen As BorderDefinition
  Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Name Einfügen")
  Dim ZielRahmen As BorderDefinition
  Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc, True)
 
  Dim QuellSchriftfeld As TitleBlockDefinition
  Set QuellSchriftfeld = QuellDoc.TitleBlockDefinitions.Item("NameEinfügen")
  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
 
'gleicht die localen Stile mit den Globalen ab und löscht nicht benutzte (Step#10)
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oStyle As Style
    For Each oStyle In oDoc.StylesManager.Styles
    If oStyle.StyleLocation = kBothStyleLocation Then
    If Not oStyle.UpToDate Then
    oStyle.UpdateFromGlobal
    End If

    If Not oStyle.InUse Then
    oStyle.Delete
   
End If
End If
Next
 
End Sub

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

BlueJay

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

---

Guten Morgen,

das gibt erst mal 10 Üs für das Veröffentlichen Deiner Arbeit!

------------------
Gruß Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
- Rettungshundestaffel des DRK in Viersen
Das könnt Ihr auch tun.

[Diese Nachricht wurde von lbcad am 02. Okt. 2012 editiert.]

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

---

Hallo Bluejay,

vielen Dank für das zur Verfügung gestellte Makro.

Leider läuft es bei mir nicht richtig.
Ich kann feststellen, dass es die Stilbibliothek anpasst und den Rahmen und das Schriftfeld löscht.
Soweit so gut.
Nun mein Problem:
Es kopiert mir nicht das neue Schriftfeld, Rahmen und skizzierte Symbole auf die Zeichnung. Ich nehme an das hat nichts mit dem Pfad zu tun, denn die Msg-Box bringt nach kopieren des Quellpfades jetzt auch keine Fehlermeldung wie zuvor von wegen kann Vorlagendatei nicht finden. Also sollte Quellpfad auch in Ordnung sein.

Ich nehme an es liegt an den Bereichen im Makro, in denen ich etwas anderes falsch eingebe.

'Resourcen der Template defenieren und Kopieren(Step#5)
  Dim oSketchedSymbolDef As SketchedSymbolDefinition
  Dim QuellDoc As DrawingDocument
  Set QuellDoc = ThisApplication.Documents.Open("Hier Pfad der Vorlagedatei eingeben")

Hier denke ich, dass alles in Ordnung ist?!

Dim QuellRahmen As BorderDefinition
  Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Name Einfügen")
  Dim ZielRahmen As BorderDefinition
  Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc, True)

Hier soll man den Namen des Quellrahmens eingeben, nur welchen?
Ich habe in meiner Vorlage ja Rahmen für DIN A4, DIN A3 etc. ???

Dim QuellSchriftfeld As TitleBlockDefinition
  Set QuellSchriftfeld = QuellDoc.TitleBlockDefinitions.Item("NameEinfügen")
  Dim ZielSchriftfeld As TitleBlockDefinition
  Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc, True)

Hier soll man den Namen des Schriftfeldes angeben, ok kein Problem, der hat sich nie geändert und es ist auch nur ein Schriftfeld vorhanden. Doch es funzt leider trotzdem nicht???

'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

Das müsste bei richtiger Pfadeingabe doch immer funzen oder???

Was muss ich berücksichtigen??
Bitte um kleine Hilfestellung bzw. Anleitung

MfG Ehli

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

---

TemplateimBrowser.jpg

Hallo Ehli,
also ich habe eine Template die liegt bei mir im Netzwerk, so das alle mit der gleichen Template arbeiten.

In dieser Template befinden die
- Ränder (ESM Rahmen + Standardrahmen)
- Schriftfelder (ESM DE)
- Skizzierten Symbole (Anzahl steigend)

des weiteren befinden sich in meiner Template je ein Blatt für die verschiedenen Formate - bei Zeichnungserstellung lasse ich nur das benutze Blatt in der Datei die anderen Lösche ich.

Zu 1.
Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Name Einfügen")
Name währe in meinem Falle siehe oben ("ESM Rahmen")

zu 2.
Set QuellSchriftfeld = QuellDoc.TitleBlockDefinitions.Item("NameEinfügen")
Name währe in meinem Falle siehe oben ("ESM DE")

zu 3.
soltte bei richtiger Pfad eingabe zur Template funktionieren

schaue dir mal den Aufbau der Template (angehängtes Bild) sowie den Pfad noch mal an - Bei Fragen einfach Rückfragen.

MFG

Bluejay

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

BlueJay

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

---

Featurebaum.jpg

Hallo Bluejay,

vielen Dank für deine Antwort.

Bei mir liegt die Template auch auf dem Server.
Netzwerkpfad: N:\Inventor2012\Vorlagen\EMF_Zeichnung

Zitat:

---

Zu 1.
Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Name Einfügen")
Name währe in meinem Falle siehe oben ("ESM Rahmen")

---

Da gehen die Probleme schon los. Ich habe insgesamt 5 Rahmen.(siehe Bild)
Wie funktioniert das denn mit nur einem bei verschiedenen Blattgrößen?
Muss ich mir wohl nochmal durchlesen.

Zitat:

---

zu 2.
Set QuellSchriftfeld = QuellDoc.TitleBlockDefinitions.Item("NameEinfügen")
Name währe in meinem Falle siehe oben ("ESM DE")

---

Da müsste dann bei mir ("Schriftfeld - EMF") rein, richtig?

Nur warum funktionieren auch die Skizzierten Symbole nicht???

Thx...

MfG Ehli

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

---

Norm.idw

Hallo Ehli,
ich habe dier mal eine entstrippte Vorlagedatei wie ich sie im Netzwerk habe angehängt - dort kanst du auch herausfinden wie ich das mit den anpassbaren Rahmen für die verschiedenen Blattformate gemacht habe.

Mit dem Schrifftfeldnamenseintrag sollte so Richtig sein - Die Symbole sollten funktionieren, allerdings werden Symbole die auf der Vorlage, sowie auf der Zeichnung vorhanden sind nicht gelöscht und ersetzt, nur in den Resourcen und zwar aus dem Grund, das diese einen Bezug zu Zeichnungsinhalten haben könnten und dieser Bezug nicht verloren gehen sollte.

Versuche es mal mit meiner Vorlage - musst nur den Schriftfeldnamen ändern

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

BlueJay

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

---

Hallo Bluejay,

vielen Dank für deine Hilfe und Antworten.
Jetzt begreife ich, wie du das mit dem Rahmen gemacht hast.
Clever gelöst.

Ich werde mir das ganze bei Gelegenheit mal wieder ansehen. Momentan is hier wieder der Bär los.

Melde mich sobald ich Näheres weiß. Ich weiß nur nicht, wann ich wieder dazu komme.

Also nochmals vielen Dank für deine Mühe.

Gruß Ehli

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