---

Hallo zusammen.
Ich hab etwas herumgesurft hier im Forum.

Mein Ziel wäre es einen Block automatisiert

- auf den 0 Punkt einer Zeichnung einzufügen
- Zoom grenzen zu machen
- Den Block als "WMF" abzuspeichern
- den Block wieder zu löschen.

Ich habe einzelne Sachen hier gefunden, welche ich aber nich zum laufen bringe, kriege Fehlermeldungen en Masse! :-)

Hat jemand Beispiele für die einzelnen Schritte?

Herzlichen Dank

------------------
ich bin neu - kann nix :-)

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

---

Hallo Patrick,

Zu 1: Schau dir in der Hilfe die Methode Insert Block an.
Zu 2: Die Methode lautet: ZoomExtents.
Zu 3: Schau mal unter Export nach.
Den Blocj löschen kannst du ja mit Object.delete machen. Da du denn Namen vom Einfügen kennst, kannst du ihn ja auch leicht in der Zeichnung finden.

Gruß, Carsten

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

---

Hi! :-)

Hab einiges geschafft, bis hin zum Block einfügen und diesen zoomen funktioniert alles wunderbar.

Anschliessend, das wmf erstellen (mit export) und den block wieder löschen geht nicht so ganz! :-(

Code:

---

Private Sub pack2wmf()
'On Error Resume Next

'Alle Verzeichnisse unter "T:\Mobiliar\" auslesen
Set f1 = fso.GetFolder("T:\Mobiliar\")
For Each sf1 In f1.SubFolders
            'Alle Verzeichnisse unter "f1" auslesen (Unterverzeichnisse in "T:\Mobiliar\")
            Set f2 = fso.GetFolder("T:\Mobiliar\" & Mid(sf1, 13))
                  For Each sf2 In f2.SubFolders
                        'Alle Verzeichnisse unter f2 auslesen (Unterverzeichnisse in "T:\Mobiliar\ & f1")
                        Set f3 = fso.GetFolder(sf2)
                              For Each fn1 In f3.Files
                                    'Jeden Block einfügen, zoomen, als wmf-speichern und wieder löschen
                                    If fn1.Name Like "*.dwg" Then
                                          'attreq definieren
                                          ThisDrawing.SendCommand ("attreq 0 ")
                                          'block einfügen
                                          pfad = fn1
                                          path = """" & (Replace(pfad, "\", "/")) & """"
                                          ThisDrawing.SetVariable "cmdecho", 0
                                          ThisDrawing.SendCommand "(blockIn2 " & path & ")" & vbCr
                                          'Zoom Grenzen
                                          ThisDrawing.Application.ZoomExtents
                                          'Exportpfad und Name definieren
                                          exportFile = (Replace(pfad, ".dwg", ""))
                                          'Create an Selectionset
                                          Set sset = ThisDrawing.SelectionSets.Add(Replace(fn1.Name, ".dwg", ""))
                                          'exportieren Block
                                          ThisDrawing.Export exportFile, "WMF", sset
                                          'löscht Block aus SelectionSet
                                          sset.Item((Replace(fn1.Name, ".dwg", ""))).Delete
                                          'attreq zurücksetzen
                                          ThisDrawing.SendCommand ("attreq 1 ")
                                    End If
                              Next
                  Next
Next
End Sub

---

Hat jemand ne Idee, wie ich den Code anpassen sollte? :-)

------------------
ich bin neu - kann nix :-)

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

---

Hallo Patrick,

Du sollst die Variablen von Autocad, wie attreq, nicht mit sendcommand setzen. Besser ist es so: ThisDrawing.SetVariable "attreq", 0
Um den Block zu löschen sollte es mit sset.Item(0).Delete gehen.

Gruß, Carsten

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

---

Hi Carsten!
Herzlichen Dank!

Leider funktioniert es mit

Code:

---

sset.Item(0).Delete

---

nicht!

Ich habe also noch 2 Probleme:
er löscht den Block nach der Erstellung des Bildes weder physisch raus noch aus dem Selectionset.

Hast du noch ne Idee?

Der code sieht momentan so aus:

Code:

---

For Each fn1 In f3.Files
      'Jeden Block einfügen, zoomen, als wmf-speichern und wieder löschen
      If fn1.Name Like "*.dwg" Then
            'attreq definieren
            ThisDrawing.SetVariable "attreq", 0

            'block einfügen
            pfad = fn1
            path = """" & (Replace(pfad, "\", "/")) & """"
            ThisDrawing.SetVariable "cmdecho", 0
            ThisDrawing.SendCommand "(blockIn2 " & path & ")" & vbCr

            'Zoom Grenzen
            ThisDrawing.Application.ZoomExtents

            'Exportpfad und Name definieren
            exportFile = (Replace(pfad, ".dwg", ""))

            'Create an Selectionset
            Set sset = ThisDrawing.SelectionSets.Add((Replace(fn1.Name, ".dwg", "")))
            sset.Select (acSelectionSetAll)

            'exportieren Block
            ThisDrawing.Export exportFile, "WMF", sset

            'löscht Block aus SelectionSet
            sset.Item(0).Delete
           
            'block physisch löschen
            'hier wäre der Code um den Block zu löschen!
           
            'attreq zurücksetzen
            ThisDrawing.SetVariable "attreq", 1
      End If
Next

---

Block einfügen funktioniert!
zoom funktioniert
Attreq setzen funzt
Bild erstellen ans richtige Ort funktioniert

- löschen aus selectionset funzt nicht
- block physisch löschen aus Zeichnung krieg ich auch nicht hin

:-)

------------------
ich bin neu - kann nix :-)

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

---

hi nochma.

Code:

---

sset.Delete

---

dann ist er aus dem SelectionSet raus, bzw. das SelectionSet ist gelöscht, glaube ich und wird beim nächsten Durchlauf der Schlaufe einfach wieder mit dem nächsten Element erstellt. :-)

Jetzt muss der Block nur noch physisch aus der Zeichnung entfernt werden, bevor die Schlaufe wieder mit dem nächsten Block von vorne beginnt. :-)

------------------
ich bin neu - kann nix :-)

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

---

Habs:

Code:

---

For Each BlockRefObj In ThisDrawing.ModelSpace
      BlockRefObj.Delete
Next

---

Jetzt funzts!! :-)

Grüsse & Danke an Carsten!!!

------------------
ich bin neu - kann nix :-)

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