---

Hallo,

ich wollte mal kurz fragen ob folgendes Programm ohne weiteres zu realisieren ist:

Ich möchte automatisch per VBA alle Objekte einer Zeichnung auswählen und in eine andere Zeichnung einfügen. Also quasi Kopieren mit Basispunkt(0,0) in der Quelldatei und Einfügen bei 0,0 in der Zieldatei automatisieren, da ich die manchmal für viel Zeichnungen machen muss.

Selectiert hab ich die ganzen Objekte schon nur fehlt mir jetzt der Befehl um die in der Zielzeichnung einzufügen.

Code:

---

        If (Dir(LB_Dateiliste.List(i, 0)) <> "") Then
            Documents.Open (LB_Dateiliste.List(i, 0))
            Set sourceDrawing = Documents.item(Documents.Count - 1)
           
            sourceDrawing.Activate
       
            Dim selectionSet As AcadSelectionSet
                 
            ' Bei Fehler -> Weitermachen, da .delete bei nicht vorhandensein einen Fehler wirft
            On Error Resume Next
       
            ' Löschen und neu Anlegen des Auswahlsatzes
            sourceDrawing.SelectionSets.item("").Delete
            Set selectionSet = sourceDrawing.SelectionSets.Add("TS_AUSWAHL")

            ' Bei Fehler -> Normales Verhalten
            On Error GoTo 0
           
            selectionSet.Select acSelectionSetAll
                     
            destinationDrawing.Active

        End If

---

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

---

hi,

such mal in der acad-vba-hilfe nach 'CopyObjects', da hast du auch ein beispiel, wie du document-/database-uebergreifend kopieren kannst.

- alfred -

---

Es geht aber doch auch ohne Programmierung recht fix:
Moglichkeit 1:
Zeichnung als Block einfügen mit automatschem Auflösen (Ursprung) und Einfügen auf 0,0
(Da ist nur die Dateiauswahl nötig und ein OK)

Möglichkeit 2  - 4 Tastenkobinationen:
Annahme:Quell- und Zilzeichnung sind bereits geöffnet
STRQ + A  (Alles Markieren in Quellzeichnung)
STRG + C  (Alles in Zwischenablage Kopieren)
STRG + TAB zur Zielzeichnung wechseln
STRG + SHIFT + Y  (ORIGEINFÜG - Mit Originalkoordinten einfügen) Diese Tastenkombi muss noch def. werden, die anderen sind Standard.

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

Auch ganz fix und ohne Programmierung

Annahme:Quell- und Zielzeichnung sind bereits geöffnet
PullDownMenü Fenster --> Nebeneinander oder Untereinander
STRQ + A  (Alles Markieren in Quellzeichnung)
in Quellzeichnung rechte Maustaste drücken und Zeichnung in Zielzeichnung ziehen
Taste lösen und gewünschte Option wählen

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

---

Danke für eure Antworten.

Aber es geht hier wirklich um wiederkehrende Arbeiten mit massenweise Zeichnungen, weswegen sich das Programmieren schon lohnt. Formular und den Rest hab ich ja auch schon fertig, das war nur ne Stunde Arbeit, leider scheiter ich jetzt jedoch am Einfügen der Objekte.

Den Tipp mit CopyObjects werd ich mir mal genauer anschauen

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

---

Hallo,
das mit "copyobjects" funktioniert recht gut. Wenn auch etwas langsam bei großen Dateien. Ich habe dazu folgende Prozedur geschrieben:

Public Sub copyalle()
Dim Enti As AcadEntity
Dim Alle() As Object
Dim i As Integer
Dim olddwg As AcadDocument
Dim newdwg As AcadDocument
Dim newobj As Variant
 
    i = 0
    Set olddwg = ThisDrawing
    ReDim Alle(olddwg.ModelSpace.layout.block.Count - 1)
    Set newdwg = ThisDrawing.Application.Documents(1)
    For Each Enti In olddwg.ModelSpace.layout.block
        Set Alle(i) = Enti
        i = i + 1
    Next Enti
    MsgBox i
    newobj = olddwg.CopyObjects(Alle, newdwg.ModelSpace)
End Sub

Dabei gehe ich davon aus, daß im Fenster eins die Quelldatei geöffnet ist und in Fenster 2 die Zieldatei. Aktiv ist Fenster 1. Viel Spass beim Probieren und hoffentlich hilft es Dir etwas weiter.

Gruß Theo

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

---

Hi Gloem,

Dumme Frage: Wenn du alles aus der Quelldatei kopieren willst, warum öffnest du die Quelldatei nicht und speichert diese unter einem neuen Namen ab?!

Und sonst gäbe es noch die WBlock-Methode, wo du mit einem Selectionset eine Vorauswahl der Objekte machen kannst.
Das sollte auf jeden Fall bei größeren Dateien das schnellste sein.

Gruß, Carsten

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

---

Weil jedesmal die Daten aus 30 bis 50Dateien zusammenkopiert werden müssen

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

---

Hi,

Und wie wäre es dann mit der InsertBlock-Methode und eventuell nach dem Einfügen sprengen?!

Gruß, Carsten

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

---

Die Importfunktion von Theo funktioniert ganz gut und das Formular drumrum hat auch nicht lange gebraucht. Aer trotzdem danke für alle weiteren Lösungsvorschläge

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

---

Hallo zusammen,

ich möchte nochmal aufgreifen. Ich habe mal den Code von Theo37 getestet, funktioniert gut.
Nun habe ich aber festgestellt, daß keine Bemassung kopiert wird ?!? Wenn ich das Objektmodell richtig verstehe, müßten doch Bemassungselemente auch unter die zu kopierenden Elemente fallen...

Kann da jemand nachvollziehen, bzw. hat jemand eine Lösung dafür ?

Danke, Gruß Georg

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

---

Hallo Georg,

die Bemassungen werden schon mit kopiert. Nur werden sie, in der neuen Datei, erst angezeigt wenn man "Bemassung aktualisiern" ausführt.

Gruß, Theo

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

---

Hallo Theo,

super, das funktioniert. Ich konnte mir aber bisher nur so helfen, indem ich die Zeichnung geschlossen und wieder geöffnet habe.
Bei 'Bemassung aktualisieren' im Menü muß ich ja Objekte anwählen, die ich nicht sehe... ?!?

Hast Du eine Idee für einen VBA-Befehl ?

Nochmals besten Dank, Dein Tipp hat auf jeden Fall geholfen.

Gruß GEorg

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

---

Hallo Georg,

ich habe auf die Anfrage "Objekte wählen:" mit "Alle" geantwortet, dann werden alle Bemaßungen der Zeichnung aktualisiert.

Das mit VBA zu lösen wäre kein Problem. Mann müsste nur alle Objekte prüfen ob es sich ume eine Bemaßung handelt und wenn ja dann aktualisiern.

Leider ist es doch ein Problem, weil es in ACAD 10 verschiedene Bemaßungsobjekte gibt. Das ist eine Frage an die Profis wie man die möglichst einfach erwischt. Ich weiß zumindest keine schnelle Lösung

Gruß, Theo

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

---

Hallo Theo,

ja, so gehts. Vielen Dank noch mal, ich forsche jetzt mal nach einer VBA-Lösung.

Gruß Georg

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