---

Hallo zusammen,
ich möchte gerne auf Knopfdruck (per VBA) die Schriftköpfe aktualisieren.
Das stelle ich mir so vor, dass in ein aktuell geöffnetes Dokument die Schriftköpfe aus einer Vorlagendatei hineinkopiert / bzw. diese aktualisiert werden.
Die Vorlagendatei liegt an einem bestimmten Ort auf dem Server.
Was ich nicht hinbekomme ist Folgendes:
Ich weiß nicht genau, wie ich im VBA Objekte einer Datei geladen bekomme, die nicht geöffnet ist.
Es wird doch bestimmt möglich sein, dass VBA bspw. einen Schriftkopf aus einer bestimmten Datei in den Speicher holt, die ich dann per VBA verarbeiten kann.
Wäre nett, wenn Ihr mir helfen könntet.

------------------
Mit freundlichem Glückauf

de-os

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

---

Schon mal den Übertragungsassistenten für Zeichnungsressourcen ausprobiert?

Unter Programme/Autodesk/Inventor../Werkzeuge

------------------
Gruß
SEHER
www.inventor-tools.de

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

---

Hallo Seher,
die Funktion ist mir zwar bekannt, ich weiß auch, dass sie funktioniert. Ich möchte allerdings dieses per VBA realisieren, da unsere User einfach nur einen Knopf drücken sollen.
Wäre nett, wenn mir jemand einen Tipp geben könnte, wie das funktioniert.

------------------
Mit freundlichem Glückauf

de-os

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

---

1. aktuelle Datei ermitteln
dim odoc as drawingdocument
Set odoc = ThisApplication.ActiveDocument

2. die Datei, die das neue Schriftfeld enthält öffnen

dim newdoc as drawingdocument
Set newdoc = ThisApplication.Documents.Open(hier den Pfad, False)

3. Schriftfeld in Speicher holen:
Dim oTitleDef As TitleBlockDefinition
Set oTitleDef = oSymDoc.TitleBlockDefinitions(hier Name des Schriftfeldes)

4. Schriftfeld in aktulle Zeichnung kopieren:
Call oTitleDef.CopyTo(odoc, True)

Wenn das neue und das alte Schriftfeld den gleichen Namen haben, dann wird das alte durch das neue ersetzt.

Gruß
Reinhard

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

---

Hallo Reinhard,
das war genau das, was ich meinte.
Ich werde das heute mal ausprobieren.
Vielen, vielen Dank.

------------------
Mit freundlichem Glückauf

de-os

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

---

Wollte mich nur bedanken. Funktioniert perfekt.
Hier dann mein endgültiger Code:

Public Sub Alle_Schriftfelder_holen()
Dim oApp As Application
Set oApp = ThisApplication
Dim oDoc As Document
Set oDoc = oApp.ActiveDocument
Dim newDoc As Document
Set newDoc = oApp.Documents.Open("c:\temp1.idw", False)
Dim oTitleDef As TitleBlockDefinition
Dim iZahl As Integer
For iZahl = newDoc.TitleBlockDefinitions.Count To 1 Step -1
    Set oTitleDef = newDoc.TitleBlockDefinitions.Item(iZahl)
    Call oTitleDef.CopyTo(oDoc, True)
Next iZahl
End Sub

------------------
Mit freundlichem Glückauf

de-os

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

---

Zitat:

---

Original erstellt von de-os:

Public Sub Alle_Schriftfelder_holen()
Dim oApp As Application
Set oApp = ThisApplication
Dim oDoc As Document
Set oDoc = oApp.ActiveDocument
Dim newDoc As Document
Set newDoc = oApp.Documents.Open("c:\temp1.idw", False)
Dim oTitleDef As TitleBlockDefinition
Dim iZahl As Integer
For iZahl = newDoc.TitleBlockDefinitions.Count To 1 Step -1
    Set oTitleDef = newDoc.TitleBlockDefinitions.Item(iZahl)
    Call oTitleDef.CopyTo(oDoc, True)
Next iZahl
End Sub

---

Funktioniert wirklich super!

Interessant wäre hier noch wie man eventuell noch bestehende/vorhandene Schriftköpfe, ausser den Neu eingefügten und ersetzten/überschriebenen/aktualsierten Schriftköpfen, löschen kann?

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

---

Hallo

Du könntest in der Zielzeichnung vorab alle nicht verwendeten Schriftfelder löschen.

Code:

---

Public Sub Alle_ungenutzten_Schriftfelder_löschen()
Dim oApp As Application
Set oApp = ThisApplication
Dim oDoc As Document
Set oDoc = oApp.ActiveDocument

Dim oTitleDef As TitleBlockDefinition

For each  oTitleDef in oDoc.TitleBlockDefinitions
    If oTitleDef.InUse = False Then
        oTitleDef.Delete
    End If
Nex
End Sub

---

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

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

---

Danke!

Das sieht vielversprechend aus!

EDIT:

Er bricht leider in der Zeile "If oTitleDef.InUse = False Then" (Kommentar False=False) ab wenn eines der Schriftfelder in einem Blatt vorkommt. Wird keines verwendet läuft das Programm durch (ist ja nicht im Sinne des Vorhabens).

Viele Grüße,

[Diese Nachricht wurde von EKW am 02. Apr. 2014 editiert.]

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

---

Hallo,

doppelte Negierung ??

--> Edit sagt: es muss IsReferenced heißen.
Dann läuft's (kann das DIN-Schriftfeld nicht gelöscht werden?)

funktioniert

Code:

---

If Not oTitleDef.IsReferenced Then
        oTitleDef.Delete
End If

---

------------------
Gruß Roland

[Diese Nachricht wurde von RolandD am 02. Apr. 2014 editiert.]

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

---

Vielen Dank Roland!

Das war die Lösung 

Da braucht man wirklich sehr gute Kenntnisse um da den Unterschied herauszufiltern 

Viele Grüße,

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