---

Hallo zusammen,

Ich habe ein "fremdes" Makro, das mir entsprechend meinen Zeichnungsrahmen anpasst, die Indexstände ändert und meine Schriftkopfeinträge wunderbar verwaltet. Kurzum ein dolles Ding.
Jetzt haben wir noch ein eigenes Makro das Messpunkte aus einem Part ausliest, eine Tabelle aus Linien und Texten in den Blatthintergrund erstellt und die Werte der Messpunkte einträgt.

Wenn ich aber jetzt das Zeichnungsblatt (Größe) ändere, Löscht das erste Makro den kompletten Blatthintergrund, das bedeutet meine Messtabelle wird auch gelöscht.

Jetzt meine Idee: Ich kopiere per Makro meine Tabellenelemente (Linien und Texte) aus dem Blatthintergrund in die Arbeitsansicht, Starte das erste Makro und wenn es fertig ist kopiere ich meine Tabellenelemente einfach zurück in den Blatthintergrund.

Mein Code:
  Sub copieren()
  Set drwdocument = CATIA.ActiveDocument
  Set DrwSheets = drwdocument.Sheets
  Dim selection3 As Selection
  Set selection3 = drwdocument.Selection
  selection3.Clear
  selection3.Search ("Name=*Testlinie*,all")
'  selection3.Copy
'  DrwSheet.Views.Item(1).Activate  'Working View aktivieren
'  Set DrwSheet = DrwSheets.Item("Sheet.1")
'  DrwSheet.Activate
  selection3.Paste
End Sub

Was Passiert: Die Linie (Muss natürlich vorhanden sein) wird im Blatthintergrund kopiert und nicht, wie erwartet in die Arbeitsansicht.
Die Ausgeklammerten Befehle tun selbst wenn ich sie aktiviere nichts.

Kann mir jemand helfen ?

------------------
Grüße aus dem Schwarzwald
Viktor

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

---

Hallo Viktor,

ohne es getestet zu haben könnte Dein Makro so aussehen:

Code:

---

  Sub copieren()
  Set drwdocument = CATIA.ActiveDocument
  Set DrwSheets = drwdocument.Sheets
  Dim selection3 As Selection
  Set selection3 = drwdocument.Selection
  selection3.Clear
  selection3.Search ("Name=*Testlinie*,all")
  selection3.Copy
  selection.Clear
'  DrwSheet.Views.Item(1).Activate  'Working View aktivieren
  Set DrwSheet = DrwSheets.Item("Sheet.1")
'  DrwSheet.Activate
  selection3.Add(DrwSheet)
  selection3.Paste
End Sub

---

Vor dem Einfügen musst Du das Ziel für Deine Elemente auswählen.
Evtl. musst du noch das Sheet aktivieren.

Hoffe das funzt so.
Gruß, Alex

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

---

Danke Alex,

aber
bei:
selection3.Add (DrwSheet) -> Object doesen't support this property or method

und bei:
selection3.Add DrwSheet -> Object required

Fällt Dir noch etwas ein?
Bin für jeden Tip dankbar

------------------
Grüße aus dem Schwarzwald
Viktor

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

---

Hallo,

versuche es mal mit

Code:

---

selection3.Add (DrwSheet.views.item(2))

---

Interaktiv kannst Du auch keine Geometrie auf den Blatt einfügen (bzw. wird dort automatisch Views.item(1), MainView ausgewählt.
So müsste es funktionieren.

Gruß,
Zoltan

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

---

Hallo cevk,

sollte es nicht so gehen:

Code:

---

Sub copieren()
    Set drwdocument = CATIA.ActiveDocument
    Set DrwSheets = drwdocument.Sheets
    Set DrwSheet = DrwSheets.ActiveSheet
    Dim selection3 As Selection
    Set selection3 = drwdocument.Selection
    selection3.Clear
    selection3.Add DrwSheet.Views.Item(2)
    selection3.Search ("Name=*Testlinie*,all")
    selection3.Copy
    selection3.Clear
    selection3.Add DrwSheet.Views.Item(2)
    selection3.Paste
End Sub

---

Damit sollte die Auswahl aus dem Background des aktuellen Sheets kopiert und auch wieder dort eingefügt werden.

mfg,
Lusilnie

------------------

Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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

---

Hallo Zoltan,
Hallo Lusilnie,

viiiiiiiiiiiiiiiiiieeeeeeeeeeelen Dank, ihr habt mir sehr geholfen, lasst Euch umarmen KlKr.    

Habe noch eine Kleinigkeit modifiziert.

Code:

Sub copieren()
    Set drwdocument = CATIA.ActiveDocument
    Set DrwSheets = drwdocument.Sheets
    Set DrwSheet = DrwSheets.ActiveSheet
    Dim selection3 As Selection
    Set selection3 = drwdocument.Selection
    selection3.Clear
    selection3.Add DrwSheet.Views.Item(2)
    selection3.Search ("Name=*Testlinie*,all")
    selection3.Copy
    selection3.Clear
    selection3.Add DrwSheet.Views.Item(1)
    selection3.Paste
End Sub

Eure Units habt ihr euch redlich verdient.

Gruß cevk

------------------
Grüße aus dem Schwarzwald
Viktor

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