---

Hallo,

ich möchte mit VB ein Formular erstellen, in dem ich von einer geöffneten AutoCAD-DWG aus einen Ordner mit Blöcken auswählen und dann daraus einen Block wählen kann, der dann in einem Vorschaufenster angezeigt wird (Vorschau). Wenn es der richtige Block ist soll dieser in die DWG eingefügt werden. Wie dies über das WMF-Format funktioniert, habe ich schon in diesem Forum weiter unten lesen können.
Jetzt meine Frage: AutoCAD speichert doch selbst ein Dia von jeder Zeichnung in die DWG-Datei ab. Kann man nicht dieses Dia selbst auslesen, wie z.B. bei der Auswahl einer DWG in AutoCAD (Datei öffnen)? Hier wird doch auch eine Vorschau angezeigt!
Wie kann ich diese Vorschau mit dem Dia realisieren?
Vielen Dank vorab für Eure Hilfe.

mfg
Wolfgang

[Diese Nachricht wurde von WolfgangSCH am 19. Aug. 2005 editiert.]

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

---

Ob das so direkt wohl geht? Ich glaube nicht - jedenfalls gibt es (genau wie in deinem anderen Posting) keine ActiveX-Methode dafür. Und wieder mal: In Lisp bestehen da bessere Möglichkeiten, die Previews hängen mit GC 310 im BLOCK_RECORD eines Inserts. Da sind sie mir schon öfters begegnet. Vermutlich findet sich dann auch am BLOCK_RECORD des *modelspace* ein solcher 310er, der dann das Prieview des Modellbereichs enthält.

Wie die Binärdaten dann aber zu interpretieren sind, ist noch eine ganz andere Frage. Ich habe das nie ausprobiert, aber ich vermute, dass es sich um ein DIB handelt. Daraus könnte man ein BMP bauen, wenn man sich a) die Palette baut, die sollte den ACI-Farbraum enthalten, und dann noch den BMP-Header davorklebt.

Aber noch mal deutlich: Viele Wenns und Abers! Vermutlich DIB, vermutlich 256 Farben, und in VBA sowieso nicht, wenn, dann nur in Lisp - und da besteht das Problem, dass Lisp nativ keine Binärdaten lesen/schreiben kann, da braucht man noch einen Teil in C/C++ dazu.

Kann aber auch sein, dass ich was übersehe... Irgendwo hab ich auch mal was davon gelesen, dass man über das Designcenter was programmieren kann, aber das habe ich nie versucht. Gibt es so etwas wie eine "Designcenter.tlb", die die COM-Methoden rausreicht? Vielleicht weiss da jemand anders mehr.

Gruß, Axel Strube-Zettler

------------------
Meine AutoLisp-Seiten Mein Angriff auf dein Zwerchfell Mein Lexikon der Fotografie Mein gereimtes Gesülze

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

---

Hallo Axel,

danke für Deine Antwort, welche ja nicht gerade Mut macht.
Aber ich werde Deinen Tipps einmal ausprobieren und versuchen das Problem so in den Griff zu bekommen.

Gruß
Wolfgang

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

---

Hallo Wolfgang

Ich hätte da noch einen Vorschlag
„DwgThumbnail.ocx“ zeigt dir eine Vorschau einer Dwg-Datei an.

mfg
Joe

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

---

Hallo Wolfgang,

wie in anderen Beiträgen schon ausführlich diskutiert
das Thema Blockvoransicht.
Wenn die Blöcke schon in der Zeichnung sind kann man das doch über die Werkzugpaletten (ab 2004) lösen.
Wenn die Blöcke auf der Platte schlummern und z.B. durch ein
Tool mitgeliefert werden, kann man schon die Variante mit WMF
oder BMP nehmen. Es ist für den Anwender ein wenig Arbeit die
Blöcke zu erstellen.
Die WMF kann man automatisiert erstellen. Dazu ein Beispiel:

Code:

---

Private Sub CommandButton1_Click()
Dim aktWinState As Integer
Dim aktHeight As Long
Dim aktWidth As Long
Dim insPkt(0 To 2) As Double
Dim BlockDef As AcadBlock
Dim BlockName As String
Dim MinPkt(0 To 2) As Double
Dim MaxPkt(0 To 2) As Double
Dim SelSet As AcadSelectionSet
' Muss Array sein für SelSet
Dim BlockSel(0) As AcadEntity

' Fenster merken
aktWinState = ThisDrawing.WindowState
' Fenster klein einstellen
ThisDrawing.WindowState = acNorm
ThisDrawing.Width = 400
ThisDrawing.Height = 400

' Selectionset anlegen
On Error Resume Next
Err.Clear
Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT")
If Err.Number <> 0 Then
   ' Falls vorhanden
   On Error GoTo 0
   Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT")
End If
On Error GoTo 0

' Alle Blockdefinitionen durchlaufen
For Each BlockDef In ThisDrawing.Blocks
    If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then
        BlockName = BlockDef.Name
        Me.Caption = BlockName
        ' Blockeinfügen und auf Array setzen
        Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0)
        ' Block sichtbar machen
        BlockSel(0).Update
        ' Auf Grenzen zoomen
        ThisDrawing.Application.ZoomExtents
        ' Ausschnitt vergrößern
        ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative
        ' Selektionset leeren
        SelSet.Clear
        ' Block dem Seletionset zufügen
        SelSet.AddItems BlockSel
        ' WMF exportieren
        ThisDrawing.Export "C:\Temp\" & BlockName, "wmf", SelSet
        ThisDrawing.Export "C:\Temp\" & BlockName, "bmp", SelSet
        ThisDrawing.Export "C:\Temp\" & BlockName, "dxf", SelSet
        ' Blockreferenz wieder löschen
        BlockSel(0).Delete
       
     End If
Next BlockDef

Me.Caption = "Fertig"

ThisDrawing.WindowState = aktWinState
ThisDrawing.Regen acAllViewports

End Sub

---

Vielleicht hilfts dir oder Dirk.B weiter.

Stelli1

[Diese Nachricht wurde von Stelli1 am 27. Aug. 2005 editiert.]

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

---

Hallo Joe,

DwgThumbnail.ocx funktioniert wie in einem Beitrag beschrieben nur bis Version 2004.
Ich werde daher wohl den Umweg über BMP's wählen.
Stelli danke auch Dir für den Tipp!

Gruß
Wolfgang

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

---

Hallo Stelli1!

Das mit dem automatisch erzeugen von wmf's von Blöcken aus einer Zeichnung hört sich gut an.
Ich habe meine Blöcke in verschiedenen Verzeichnisordnern liegen z.B.
"C:\ACAD\Bloecke\Beschlaege".
Könnte man das Programm so umschreiben, daß alle dwg's aus solch einem Ordner automatisch nacheinander geladen und als wmf und oder bmp wieder zurückgeschrieben werden?

Und wie immer, wenn ja dann wie?

Gruß

Dirk

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

---

Hallo Dirk,

sollte doch kein Problem sein. Liest du ab einem Startverzeichnis alles DWG rekursiv durch und wendest die Funktion an.

Die Dateien kannst du über das Filesystem Objekt ermitteln oder mit der Funktion DIR.

Übrigens ist in deiner DVB der Fehler so:

Code:

---

' Bei dir etwa so
Datei = dir("C:\TEMP\*.WMF"
While not Datei =""
      ' Die Rückgabe von Dir ist nur der Dateiname
      ' Beim Öffnen fehlt dir der Pfad
      msgbox Datei
      Datei =Dir
wend

' besser
Pfad = "C:\Temp\"
Datei = dir(Pfad &"*.WMF"
While not Datei =""
      ' Die Rückgabe von Dir ist nur der Dateiname
      ' Beim Öffnen musst du den Pfad angeben !!!
      msgbox Pfad & Datei
      Datei =Dir
wend

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.

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

---

Hallo Stelli!
Hallo zusammen!

Es ist schon ein wenig her mit diesem Thema, aber ich möchte es nochmal aufgreifen.

Die Blöcke aus der aktuellen Zeichnung durchlaufen lassen funktioniert gut.

Was ich aber nicht hinbekomme, ist die Blöcke aus einem Verzeichnis aus- einlesen und als WMF oder BMP wieder abzuspeichern bzw. zu exportieren.

Das Verzeichnis lautet z.B. C:\Temp

Kannst Du / Ihr mir da detailierter mit einem Code helfen?

Klasse wäre es, wenn man nun auch noch die Möglichkeit hätte, das nach dem laden des Blocks diesem an dem Einfügebunkt ein roter Punkt angehangen wird.
Diese wird dann als WMF oder BMP gespeiert, aber nicht in dem Block selber.

Für Hilfe zu dem ersten Punkt wäre ich Euch schon sehr dankbar.

mfg.

Dirk

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

---

Hi Dirk,

Wo genau hast denn noch ein Problem?! Beim Öffnen der einzelnen Zeichnungen im Verzeichnis?!

Normalerweise würde ich sagen, das du das am besten mit ObjectDBX lösen könntest, allerdings unterstützt dies keine Selectionset, damit funktioniert auch der Export als WMF nicht (Da dort ein Selectionset benötigt wird).

Poste mal deinen Ansatz und dann schauen wir weiter.

Gruß, Carsten

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

---

Bildchen1.jpg

Hallo Carsten!

Mit der Vorgabe von Stelli1 bzgl. Blöcke aus der aktuellen Zeichnung lesen und als wmf exportieren komme ich soweit klar, daß funktioniert auch.

Mein Problem ist einfach, daß ich nicht weiß bzw. hinbekomme dieses auf ein Verzeichnis mit Zeichnungen anzuwenden.

Vom Prinzip her soll es ja wie bei dem Zeichnungsdurchlauf funktionieren.

Ich drücke auf einen Button und alle Zeichnung in dem zuvor ausgewählten Verzeichnis werden geladen und als wmf exportiert.

Hier das, was ich bislang habe:

Code:

---

Option Explicit
Dim oFolder As Object

Private Sub CommandButton2_Click()
    Dim oShell As Object
'    Dim oFolder As Object
   
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(0, "Bitte einen Ordner auswählen", 1)
   
    If Not oFolder Is Nothing Then
        TextBox1.Value = oFolder.Self.Path
    End If
End Sub

Private Sub CommandButton1_Click()
'Dim fPath As String
Dim aktWinState As Integer
Dim aktHeight As Long
Dim aktWidth As Long
Dim insPkt(0 To 2) As Double
Dim BlockDef As AcadBlock
Dim BlockName As String
Dim MinPkt(0 To 2) As Double
Dim MaxPkt(0 To 2) As Double
Dim SelSet As AcadSelectionSet
' Muss Array sein für SelSet
Dim BlockSel(0) As AcadEntity
' Fenster merken
aktWinState = ThisDrawing.WindowState
' Fenster klein einstellen
ThisDrawing.WindowState = acNorm
ThisDrawing.Width = 400
ThisDrawing.Height = 400

' Selectionset anlegen
On Error Resume Next
Err.Clear
'fPath = TextBox1.Value
Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT")
If Err.Number <> 0 Then
  ' Falls vorhanden
  On Error GoTo 0
  Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT")
End If
On Error GoTo 0

' Alle Blockdefinitionen durchlaufen
For Each BlockDef In ThisDrawing.Blocks
    If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then
        BlockName = BlockDef.Name
        Me.Caption = BlockName
        ' Blockeinfügen und auf Array setzen
        Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0)
        ' Block sichtbar machen
        BlockSel(0).Update
        ' Auf Grenzen zoomen
        ThisDrawing.Application.ZoomExtents
        ' Ausschnitt vergrößern
        ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative
        ' Selektionset leeren
        SelSet.Clear
        ' Block dem Seletionset zufügen
        SelSet.AddItems BlockSel
        ' WMF exportieren
'        ThisDrawing.Export "C:\Temp\" & BlockName, "wmf", SelSet
'        ThisDrawing.Export "C:\Temp\" & BlockName, "bmp", SelSet
'        ThisDrawing.Export "C:\Temp\" & BlockName, "dxf", SelSet

        ThisDrawing.Export oFolder.Self.Path & "/" & BlockName, "wmf", SelSet

        ' Blockreferenz wieder löschen
        BlockSel(0).Delete
       
    End If
Next BlockDef

Me.Caption = "Fertig"

ThisDrawing.WindowState = aktWinState
ThisDrawing.Regen acAllViewports

End Sub

---

Für Deine / Eure Hilfe schon mal vielen Dank im voraus.

Gruß

Dirk

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

---

Hi Dirk,

Du hast doch alles in den Beiträgen stehen, was du brauchst.

Im Beitrag von Stelli steht, wie du das Verzeichnis rekursiv durchlaufen kannst. Den Pfad bekommst du ja aus deiner Pfad-Funktion. Dann öffnest du die Zeichnung und lässt deine Block-Funktion durchlaufen, danach kannst du die Zeichnung wieder schließen und die nächste öffnen usw. .

Das sollte doch kein Problem sein, oder?!

Gruß, Carsten

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

---

Hi Carsten!

Ich benötige doch noch Deine / Eure Hilfe dazu.
Die Zeichnungen mit "dir" auslesen und in einer Msgbox anzeigen lassen bekomme ich noch hin:

Code:

---

Private Sub CommandButton4_Click()
Dim Test As String
Test = Dir(oFolder.Self.Path & "\" & "*.dwg")
While Not Test = ""
    MsgBox Test
    Test = Dir
Wend
End Sub

---

Dieses aber nun umzusetzen um die Zeichnungen zu laden und als wmf zu exportieren klappt überhaupt nicht.
Hier mein Hickhack.
Für Dich zum schmunzeln!!!!!!

Code:

---

Private Sub CommandButton4_Click()
Dim Test As String
Dim insPkt1(0 To 2) As Double
Dim BlockDef1 As AcadBlock
Dim SelSet1 As AcadSelectionSet
Dim BlockSel1(0) As AcadEntity

Test = Dir(oFolder.Self.Path & "\" & "*.dwg")

' Selectionset anlegen
On Error Resume Next
Err.Clear
'fPath = TextBox1.Value
Set SelSet1 = ThisDrawing.SelectionSets.Add("WMF_EXPORT")
If Err.Number <> 0 Then
  ' Falls vorhanden
  On Error GoTo 0
  Set SelSet1 = ThisDrawing.SelectionSets("WMF_EXPORT")
End If
On Error GoTo 0

While Not Test = ""
    If Not (BlockDef1.IsLayout Or BlockDef1.IsXRef) Then
        'Test = BlockDef1.Name
        'Me.Caption = BlockName
        ' Blockeinfügen und auf Array setzen
        Set BlockSel1(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt1, Test, 1, 1, 1, 0)
        ' Block sichtbar machen
        BlockSel1(0).Update
        ' Auf Grenzen zoomen
        ThisDrawing.Application.ZoomExtents
        ' Ausschnitt vergrößern
        ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative
        ' Selektionset leeren
        SelSet1.Clear
        ' Block dem Seletionset zufügen
        SelSet1.AddItems BlockSel1
        ' WMF exportieren
        ThisDrawing.Export oFolder.Self.Path & "\" & Test, "wmf", SelSet1
        ' Blockreferenz wieder löschen
        BlockSel1(0).Delete
    End If
Test = Dir
Wend
End Sub

---

Für Hilfe, wie der Code tatsächlich lauten sollte, wäre ich wie immer dankbar.

Gruß

Dirk 

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

---

Hallo Dirk,

irgendwie kommt mir dein Code bekannt vor. Keine Ahnung wo das Problem liegt.

Da du ja immer so grosszügig U's verteilst  hier mal ein Ansatz der alle Dateien aus einem Verzeichnis liest und alle Blöcke jeder einzelnen Zeichnung nacheinander in eine leere Zeichnung kopiert und anzeigt. Als Einfügepunkt Markierung ist ein Kreis mit drin.

Das kann dann vielleicht auch jemand brauchen der aus einer beliebigen Zeichnung einen Block, ein Layout oder so was in die aktuelle Zeichnung einfügen möchte.

Ich glaube so ähnlich hast du es dir gedacht. Du musst nur noch den reinen Export nach WMF einbauen.

Vorausetzung ist eine leere Zeichnung und der Verweis auf ObjektDBX.

Code:

---

Sub BLOCKS2WMF()
    Dim Pfad As String
    Dim CopyBlock As AcadBlock
    Dim BlockDef As AcadBlock
    Dim ShowBlock As AcadBlockReference
    Dim Kreis As AcadCircle
    Dim axDoc As New AxDbDocument
    Dim BlockCol(0) As Object
    Dim insPkt(0 To 2) As Double
   
    Pfad = "D:\Daten_Pz\"
   
    ' Markierung am Einfügepunkt
    Set Kreis = ThisDrawing.ModelSpace.AddCircle(insPkt, 0.1)
    Kreis.color = acRed
    Kreis.Update
   
   
    Dateiname = Dir(Pfad & "*.dwg")
    While Dateiname <> ""
        ' Zeichnung im Hintergrund öffnen
        Set axDoc = New AxDbDocument
        axDoc.Open (Pfad & Dateiname)
        ' Blocks dieser Zeichnung durchsuchen
        For Each CopyBlock In axDoc.Blocks
            ' Wenn "richtiger" Block
            If Not CopyBlock.IsLayout And Not CopyBlock.IsXRef And Not Left(CopyBlock.Name, 1) = "*" Then
                ' Blockdefinition auf Collection
                Set BlockCol(0) = CopyBlock
                ' Block in die aktuelle leere Zeichnung kopieren
                axDoc.CopyObjects BlockCol, ThisDrawing.ModelSpace
                ' Blockdefinition holen
                Set BlockDef = ThisDrawing.Blocks(CopyBlock.Name)
                ' Block einfügen
                Set ShowBlock = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockDef.Name, 1, 1, 1, 0)
                ' Block sichtbar machen
                ShowBlock.Update
               
               
                '' Block nach WMF
                ThisDrawing.Application.ZoomExtents
                ' .....
               
               
                ' Einfügung löschen
                ShowBlock.Delete
            End If
        Next CopyBlock
        ' Dokument schliessen
        Set axDoc = Nothing
        ' Nächste Datei
        Dateiname = Dir
    Wend

End Sub

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hi Wilfried,

Wie immer eine Gute Lösung. Us sind unterwegs. 

Gruß, Carsten

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

---

Hallo!

Ich nerve, ich weiß, aber ich bekomme es einfach bei mir nicht ans laufen.

Entweder verstehe ich von Grund auf den Ablauf bzw. die Zusammenhänge noch nicht, oder ....?

Vom Prinzip her sieht es recht einfach aus, ist es wahrscheinlich auch?

Ich probiere mal weiter 

Gruß

Dirk

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

---

hydrant.gif symbolmanager.gif

Hallo Dirk,

was läuft den nicht ?

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Stelli1 (Wilfried)!

Genau das versuche ich auch hinzubekommen.
Das mit den Blöcken aus der Zeichnung abspeichern unter wmf in ein zuvor ausgewähltes Verzeichnis funktioniert soweit:

Code:

---

Private Sub CommandButton1_Click()
Dim aktWinState As Integer
Dim aktHeight As Long
Dim aktWidth As Long
Dim insPkt(0 To 2) As Double
Dim BlockDef As AcadBlock
Dim BlockName As String
Dim MinPkt(0 To 2) As Double
Dim MaxPkt(0 To 2) As Double
Dim SelSet As AcadSelectionSet
Dim BlockSel(0) As AcadEntity
'---Fenster merken
aktWinState = ThisDrawing.WindowState
'---Fenster klein einstellen
ThisDrawing.WindowState = acNorm
ThisDrawing.Width = 400
ThisDrawing.Height = 400
'---Selectionset anlegen
On Error Resume Next
Err.Clear
Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT")
If Err.Number <> 0 Then
'---Falls vorhanden
  On Error GoTo 0
  Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT")
End If
On Error GoTo 0
'---Alle Blockdefinitionen durchlaufen
For Each BlockDef In ThisDrawing.Blocks
    If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then
        BlockName = BlockDef.Name
        Me.Caption = BlockName
        '---Blockeinfügen und auf Array setzen
        Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0)
        '---Block sichtbar machen
        BlockSel(0).Update
        '---Auf Grenzen zoomen
        ThisDrawing.Application.ZoomExtents
        '---Ausschnitt vergrößern
        ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative
        '---Selektionset leeren
        SelSet.Clear
        '---Block dem Seletionset zufügen
        SelSet.AddItems BlockSel
        '---WMF exportieren
        ThisDrawing.Export oFolder.Self.Path & "\" & BlockName, "wmf", SelSet
        '---Blockreferenz wieder löschen
        BlockSel(0).Delete
    End If
Next BlockDef
Me.Caption = "Fertig"
ThisDrawing.WindowState = aktWinState
ThisDrawing.Regen acAllViewports
End Sub

---

Das mit dem aus einem Verzeichnis bekomme ich einfach nicht hin, da ich nicht weiß, wie ich diesen aus Deinen Vorgaben richtig zusammenstellen muß.

Das mit dem
Dim axDoc As New AxDbDocument
Set axDoc = New AxDbDocument
und Verweis auf ObjektDBX

geht das nicht auch mit

Dim docObj As New AcadDocument
...

Genaugesagt, weiß ich nicht, wie ich in diesem Code das mit dem Dir und dem Export zu wmf realisieren kann.

Ich hoffe, Du hast noch nicht die Geduld mit mir verloren?

Gruß

Dirk

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

---

Hallo Dirk,

nimm doch mal die letzte Variante (die ganze SUB) von mir und kopiere diese in ein Modul. Unter Extras Verweise wählst du noch den Verweis Autocad/ObjectDBX Common 1xxx aus. Ändere den Pfad "D:\Daten_PZ" in deinen gewünschten Pfad. Dann erstellst du mit Datei/Neu eine leere Zeichnung. Schalte mal den Vollbildmodus des Dokumentes aus und schieb die Größe des Fensters mal ein wenig kleiner. Dann startest du mal die Funktion Blocks2wmf und du siehst alle deine Blöcke aus allen Dateien des gewählten Verzeichnisses wie im Daumenkino in der Anzeige vorbeisausen.

Klapp das ?

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Stelli1!

Das funktioniert, nur

Zitat:

---

Dann startest du mal die Funktion Blocks2wmf und du siehst alle deine Blöcke aus allen Dateien des gewählten Verzeichnisses wie im Daumenkino in der Anzeige vorbeisausen.

---

möchte ich nicht die Blöcke aus den Dateien (Zeichnungen) aus dem Verzeichnis einlesen, sondern die Dateien sind die Blöcke (WBlock).
Wie würde das den funktionieren?

Mit dem Punkt anhägen ist super.

Gruß

Dirk

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

---

Hi Dirk,

Dann wähle doch nicht die einzelnen Blöcke in den Zeichnungen, sondern einfach alles in der Zeichnung aus und kopiere diese in die offene (leere) Zeichnung.

Gruß, Carsten

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

---

Hallo!

Kann man den die einzelnen Dateien (Wblöcke) mit insertBlock einlesen, oder müßte man da evtl. anders ran, mit Zeichnung öffnen, Punkt einfügen und als wmf exportieren und dieses im Durchlauf?

Gruß

Dirk

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

---

Projekt1.zip

Hallo Dirk,

schau dir das doch mal an.

Hab mal ein wenig umgebaut und eine Exe draus gemacht.
Hast du deshalb jetzt auch VB6 ?

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

wmf.zip

Hallo Dirk,

hatte ich bisher immer anders verstanden. Bei mir sind die Blöcke thematisch zusammengefasst in verschiedenen Prototypenzeichnungen.
Vermessung > PZ_VERM.DWG
Kanal > PZ_AW_DIN.DWG
Da werden die Blöcke bei Bedarf rausgeholt.

Hab dir mal ein Beispiel gemacht mit dem es auch mit den Dateien gehen sollte. Bei mir führt aber ZoomExtend nicht immer zum gewünschten Ergebnis weil schon mal ein Einfügepunkt im Abseits liegt.

Probier es doch mal aus. (Funktion DWG2WMF)

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Stelli1!

Das funktioniert soweit prima, bis auf das von Dir schon angesprochene Problem mit dem "ZoomExtend" Einfügepunkt.
Da es sich ja bei der nun geöffneten Zeichnung nicht um einen Block handelt sondern um die Blockzeichnung ansich, die Frage:

Kann man nun das Objekt in der Zeichnung und den eingefügten Kreis zusammenbringen?
Wenn ich diese Zeichnung (Block) in eine andere Zeichnung einfüge habe ich ja einen Einfügepunkt den ich mit dem Kreis koppeln kann.
Ist dieser Punkt auch in der Zeichnung des Blocks abrufbar?

Gruß

Dirk

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

---

Hallo!

Könnte man so etwas auch hiermit lösen

Code:

---

Dim Entity As AcadEntity
Dim TestPkt As Variant
...
    If Entity.EntityType = acBlockReference Then
        Set TestBlock = Entity
        TestPkt = TestBlock.InsertionPoint
...

---

wenn ja, wie?

Gruß

Dirk

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

---

Hi Dirk,

Ich muss zugeben, das ich etwas verwirrt bin von deinem vorletzten Beitrag.  Willst du die WMFs erstellen und dann soll auch der Kreis in der der (Block-)DWG enthalten sein?!
Oder meinst du den Einfügepunkt den du beim einfügen der (Block-)DWG als Externe Referenz erhälst?!

Gruß, Carsten

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

---

Hi Carsten!

Es soll wie folgt ablaufen.

- öffnen der Zeichnung (WBlock)
- erstellen des Kreises an dem Einfügepunkt des WBlocks
- Zoom alles
- exportieren nach wmf
- Kreis wieder löschen
- Zeichnung schließen
- nächste Zeichnung usw.

Der Kreis soll nur dazu dienen, daß man in dem Bildchen sehen kann, wo der Einfügpunkt liegt.

Gruß

Dirk

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

---

Hi Dirk,

Das Proggy von Wilfried macht doch genau das, was du willst. In die leere Zeichnung wird dein Block (Einen WBlock gibt es nicht!) als Xref geladen, das Kreis wird beim Einfügepunkt (0,0) des Xrefs eingefügt und das WMF erstellt. Danach wird die Externe Referenz wieder entfernt und die nächste Zeichnung wird bearbeitet.
Wo hast du denn da noch dein Problem?

Gruß, Carsten

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

---

Hi Carsten!
Hi Wilfried!

Ich glaube, ich habe mich festgefahren.
Wenn ich die einzelnen Programme von Dir Wilfried durchlaufen lasse, funktionieren diese soweit prima.

Das mit den Zeichnungen öffnen, Kreis einfügen etc. funktioniert, bis auf das, daß das Objekt in der Zeichnung kein Block ist und somit der InsPkt nicht mit dem InsPkt des Kreises übereinstimmt.

Eigentlich müßte ich aber doch folgendes erreichen:

Eine neue Zeichnung öffnen.
In diese Zeichnung sollen nun die Dateien/Zeichnungen aus einem  Verzeichnis/Ordner automatisch nacheinander als Block eingefügt werden. Der rote Kreis soll am Insertpoint des Blocks erstellt werden. Danach wird dieses als WMF Datei exportiert und der Kreis wird wieder gelöscht, so wie die Zeichnung.

Wie müßte denn dafür der konkrete Code lauten?

Vielen Dank im voraus.

Gruß

Dirk

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

---

Hi Dirk,

Lade doch mal ein, zwei Problem-Blöcke hoch, damit man nachvollziehen kann, wo dein Fehler liegt.
Bei klappt das ohne Probleme. Villeicht hast du bei den Zeichnungen ja eine Variable verstellt?!

GRuß, Carsten

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

---

Zitat:

---

Original erstellt von Dirk.B:
Das mit den Zeichnungen öffnen, Kreis einfügen etc. funktioniert, bis auf das, daß das Objekt in der Zeichnung kein Block ist und somit der InsPkt nicht mit dem InsPkt des Kreises übereinstimmt.

---

Wenn die Zeichnung eingefügt (oder XREF) wird ist sie ein Block.
Vielleicht hast du die Blöcke falsch erzeugt. Mit dem WBLOCK Befehl kannst du ja vorhandene Blöcke oder eine Objektauswahl in eine eigene Datei schreiben. Bei einer Auswahl der Objekte kann leicht der Einfügepunkt verschoben sein. Prüf doch mal in den Zeichnungen ob diese auch wirklich 0,0 als Ursprungspunkt haben. Prüfe auch mal die Variable INSBASE mit der ein anderer Einfügepunkt definiert wird.

Zitat:

---

Wie müßte denn dafür der konkrete Code lauten?

---

Den hast du eigentlich schon.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Bildchen1.JPG

Hallo Carsten!
Hallo Wilfried!

Ich habs mir am Wochenende nochmal vorgenommen und nun hab ich es hinbekommen.
So funktioniert es.

Code:

---

Option Explicit
Dim oFolder As Object
Dim NewDoc As AcadDocument
...
...
'Ordnerauswahl
Private Sub CommandButton2_Click()
    Dim oShell As Object
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(0, "Bitte einen Ordner auswählen", 1)
   
    If Not oFolder Is Nothing Then
        TextBox1.Value = oFolder.Self.Path
    End If
End Sub
...
...
'Erstellung von WMF Dateien aus einem Verzeichnis / Ordner
Private Sub CommandButton1_Click()
Dim aktWinState As Integer
Dim aktHeight As Long
Dim aktWidth As Long
Dim Dateiname As String
Dim ImportPfad As String
Dim ExportPfad As String
Dim NewBlock As AcadBlock
Dim BlockDef As AcadBlockReference
Dim Min(2) As Double
Dim Max(2) As Double
Dim VPKreis As AcadCircle
Dim VPschraf As AcadHatch
Dim InsPkt(2) As Double
Dim Sset As AcadSelectionSet
Dim Entity(0) As AcadEntity

Set NewDoc = ThisDrawing.Application.Documents.Add

ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis wird über Ordnerauswahl in die
ExportPfad = ImportPfad

ThisDrawing.WindowState = acNorm
ThisDrawing.Height = 400
ThisDrawing.Width = 400

Dateiname = Dir(ImportPfad & "*.dwg")
While Dateiname <> ""
    Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1, 1, 1, 0)
    BlockDef.Update
    DoEvents
    Set VPKreis = ThisDrawing.ModelSpace.AddCircle(InsPkt, 2)
    VPKreis.color = acRed
    VPKreis.Update
    Set VPschraf = ThisDrawing.ModelSpace.AddHatch(0, "Solid", True)
    Set Entity(0) = VPKreis
    VPschraf.AppendOuterLoop (Entity)
    VPschraf.color = acRed
    VPschraf.Update
    Me.Caption = Dateiname
    BlockDef.GetBoundingBox Min, Max
    Application.ZoomExtents
    ThisDrawing.Regen acActiveViewport
    On Error Resume Next
    Set Sset = ThisDrawing.SelectionSets("MySel")
    If Err.Number Then
        Set Sset = ThisDrawing.SelectionSets.Add("MySel")
    End If
    On Error GoTo 0
    Sset.Clear
    Sset.Select acSelectionSetAll
    DoEvents
    ThisDrawing.Export Left(ExportPfad & Dateiname, Len(ExportPfad & Dateiname) - 4), "WMF", Sset
    BlockDef.Delete
    VPKreis.Delete
    VPschraf.Delete
    Sset.Delete
    Dateiname = Dir
Wend
NewDoc.Close
Me.Caption = "Durchlauf beendet"
End Sub

---

Nochmals danke für Eure Hilfe.

Eins hätte ich aber noch, nur mal so zur optischen Darstellung.
Könnte man nun noch einen Fortschrittbalken ProgreßBar einbauen?
An welcher Stelle müßte man dieses umsetzen und wie müßte der Code lauten?

Gruß

Dirk

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

---

Hi Dirk,

Das mit dem Progressbar sollte klappen. Dafür solltest du aber mal deine .DVB hochladen, damit man sich nicht erst was zurechtbasteln muss um zu testen, obs Fehlerfrei ist.

Gruß, Carsten

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

---

TestBlock.zip

Hallo Carsten!

Hier die *.dvb.

Gruß

Dirk

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

---

Hi Dirk,

Bau es doch einfach so ein:

Code:

---

'--------------------------------------------------------------------------------------------
'Erstellung von WMF Dateien aus einem Verzeichnis / Ordner
Private Sub CommandButton1_Click()
Dim aktWinState As Integer
Dim aktHeight As Long
Dim aktWidth As Long
Dim Dateiname As String
Dim ImportPfad As String
Dim ExportPfad As String
Dim NewBlock As AcadBlock
Dim BlockDef As AcadBlockReference
Dim Min(2) As Double
Dim Max(2) As Double
Dim VPKreis As AcadCircle
Dim VPschraf As AcadHatch
Dim InsPkt(2) As Double
Dim Sset As AcadSelectionSet
Dim Entity(0) As AcadEntity

Set NewDoc = ThisDrawing.Application.Documents.Add

ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis wird über Ordnerauswahl in die
ExportPfad = ImportPfad

ThisDrawing.WindowState = acNorm
ThisDrawing.Height = 400
ThisDrawing.Width = 400

Dateiname = Dir(ImportPfad & "*.dwg")
Do While Dateiname <> ""
    Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1, 1, 1, 0)
    BlockDef.Update
    'Markierung am Einfügepunkt
    DoEvents
    Set VPKreis = ThisDrawing.ModelSpace.AddCircle(InsPkt, 2)
    VPKreis.color = acRed
    VPKreis.Update
    Set VPschraf = ThisDrawing.ModelSpace.AddHatch(0, "Solid", True)
    Set Entity(0) = VPKreis
    VPschraf.AppendOuterLoop (Entity)
    VPschraf.color = acRed
    VPschraf.Update
   
    Me.Caption = Dateiname

    BlockDef.GetBoundingBox Min, Max
    Application.ZoomExtents
    ThisDrawing.Regen acActiveViewport
   
    On Error Resume Next
    Set Sset = ThisDrawing.SelectionSets("MySel")
    If Err.Number Then
        Set Sset = ThisDrawing.SelectionSets.Add("MySel")
    End If
    On Error GoTo 0
    Sset.Clear
    Sset.Select acSelectionSetAll
   
    DoEvents
    ThisDrawing.Export Left(ExportPfad & Dateiname, Len(ExportPfad & Dateiname) - 4), "WMF", Sset

    BlockDef.Delete
    VPKreis.Delete
    VPschraf.Delete
    Sset.Delete
   
    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop
NewDoc.Close
Me.Caption = "Durchlauf beendet"
End Sub

---

[Diese Nachricht wurde von Carsten1210 am 19. Mrz. 2007 editiert.]

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

---

Hi Carsten!

Danke, daß funktioniert soweit gut.
Der Balken läuft jedoch nur ein Stück weit. Ich denke es liegt an den Vorgabewerten "1".
Setze ich den Wert höher, läuft zwar der Balken durch, aber es werden nicht mehr alle DWG's zu WMF's erzeugt.
z.B. von 7 DWG's nur 2 WMF's.

Gruß

Dirk

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

---

TestBlock_neu.dvb.txt

Hi Dirk,

Ich habs mit 29 Dateien getestet. Bei läufts ohne Probleme durch.

Anbei noch mal die .DVB, wo auch vorher die Anzahl der Dateien im Verzeichnis ermittelt werden, damit der Fortschrittsbalken auch passend bis zum Ende läuft.
BTW.: Mein Angebot steht noch.  

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 20. Mrz. 2007 editiert.]

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

---

Hallo Carsten!

Funktioniert prima.

Danke. 

Gruß

Dirk

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

---

Hi Dirk,

Hierzu ist mir noch was aufgefallen:

Zitat:

---

Der Balken läuft jedoch nur ein Stück weit. Ich denke es liegt an den Vorgabewerten "1".
Setze ich den Wert höher, läuft zwar der Balken durch, aber es werden nicht mehr alle DWG's zu WMF's erzeugt.
z.B. von 7 DWG's nur 2 WMF's.

---

In der Schleife zum erhöhen des Fortschrittbalkens ist ja eine exit do Anweisung enthalten. Da liegt dein Fehler. Sobald der Balken am Ende ist, beendet es dein Makro. Dabei ist es egal, ob noch Dateien zum verabeiten vorhanden sind. Wenn weniger Dateien vorhanden sind, als dein Maximalwert(in verbindung mit dem Wert des Hochzählens), wird der Fortschrittsbalken nicht bis zum Ende durchlaufen.

Gruß, Carsten

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

---

Hallo Carsten!
Hallo Wilfried!

Ich hatte am Wochenende, trotz des relativ schönen Wetters bei uns, etwas Zeit nochmal alles in Ruhe durchzugehen.
Jetzt läuft alles so wie ich es gerne haben wollte, natürlich dank Eurer Hilfe.

Gruß

Dirk

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

---

Hallo zusammen!
Mein Problem ist folgendes.

Ich habe eine UserForm1, hinter der sich mein eigentlicher Programmcode verbiergt bzw. abläuft.
Wenn die Schleife Do While durchläuft

Code:

---

  Dim DateiZahl As String, i As Integer
  i = 0
  DateiZahl = Dir$(ImportPfad & "*.dwg")
  Do While DateiZahl <> ""
  i = i + 1
  DateiZahl = Dir$()
  Loop
  UserForm2.ProgressBar1.Max = i
  UserForm2.Show

Dateiname = Dir(ImportPfad & "*.dwg")
Do While Dateiname <> ""
...
...
    Dateiname = Dir
    If UserForm2.ProgressBar1 + 1 > UserForm2.ProgressBar1.Max Then Exit Do
    UserForm2.ProgressBar1 = UserForm2.ProgressBar1 + 1
    DoEvents
Loop
...

---

soll die UserForm2 auf dem Bildschirm erscheinen, in der der Fortschrittbalken einer ProgressBar abläuft.
Wie bekomme ich es hin, die UserForm2 aus der UserForm1 so aufzurufen, daß dieses auch wirklich so funktioniert.
Mit dem Programmcode bislang, wird mir zwar die UserForm2 auf dem Bildschirm angezeigt, aber die ProgressBar läuft nicht durch.

Hat da jemand eine Lösung für mich?

Vielen Dank im voraus.

Gruß

Dirk

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

---

Hi Dirk,

Wenn du das 1 Form ausblendest, sollte das 2. Form ohne Probleme laufen.
Du kannst aber auch die Form mit dem Progressbar modal starten.

Gruß, Carsten

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

---

Hi!

So funktionierts.

Code:

---

  Dim DateiZahl As String, i As Integer
  i = 0
  DateiZahl = Dir$(ImportPfad & "*.dwg")
  Do While DateiZahl <> ""
  i = i + 1
  DateiZahl = Dir$()
  Loop

  PicLoad.ProgressBar1.Max = i

Dateiname = Dir(ImportPfad & "*.dwg")
Me.Hide
Do While Dateiname <> ""
    PicLoad.Show False
    ...
    ...
    Dateiname = Dir
    PicLoad.PicLoadLab.Caption = Dateiname
    If PicLoad.ProgressBar1 + 1 > PicLoad.ProgressBar1.Max Then Exit Do
    PicLoad.ProgressBar1 = PicLoad.ProgressBar1 + 1
    DoEvents
   
Loop
Unload PicLoad
NewDoc.Close
PicLoad.ProgressBar1.Value = 0
...
Me.Show
End Sub

---

Gruß

Dirk

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

---

Hi Dirk,

Zwei Sachen hab ich noch dazu:
1. Ist ne Geschmackssache: Damit du die Userform mit dem Progressbar modeless(Ungebunden) aufrufen kannst musst du das "Hauptformular" erst ausblenden. Ich finde, das verwirrt den Benutzer nur. Aber das ist, wie gesagt eine Geschmackssache.
2. Hast du dir die Größe der WMFs mal angesehen?! Der Zoom dürfte bei dir nicht funktionierten und die WMFs dürften daher auch nicht annähernd Quadratisch sein. Kannst dir ja die WMFs mal anschauen und mich überzeugen, das es anders ist. 

Gruß, Carsten

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

---

WMF_Bild_01.jpg WMF_Bild_02.jpg

Hi Carsten!

Zitat:

---

Zwei Sachen hab ich noch dazu:
1. Ist ne Geschmackssache: Damit du die Userform mit dem Progressbar modeless(Ungebunden) aufrufen kannst musst du das "Hauptformular" erst ausblenden. Ich finde, das verwirrt den Benutzer nur. Aber das ist, wie gesagt eine Geschmackssache.
2. Hast du dir die Größe der WMFs mal angesehen?! Der Zoom dürfte bei dir nicht funktionierten und die WMFs dürften daher auch nicht annähernd Quadratisch sein. Kannst dir ja die WMFs mal anschauen und mich überzeugen, das es anders ist.

---

Zu Punkt 1.
Wie würdest Du es denn machen?

Zu Punkt 2.
Ich bin mit der Darstellung zufrieden.
Schau Dir mal die Bildchen an.

Gruß

Dirk

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

---

Hallo Drik,

Zu den Bildchen. Schau mal in die Eigenschaften der WMFs. Die sind nicht Quadratisch, wie es von der Einstellung des Zeichnungsfensters eigentlich sein sollte. Da bekommst du bei größeren Sachen vielleicht ein Problem.

Zum Progressbar: Ich würde die Userform1 einfach geöffnet lassen und die Userform mit dem Progressbar darüber einblenden und ablaufen lassen. Dann bekommt der User auch nicht das geflacker beim ablaufen der einzelnen Blöcke im Zeichnungsfenster mit.

Gruß, Carsten

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