---

Hallo!

Möchte mit VBA eingefügte Blöcke einer Zeichnung mit WBLOCK speichern. Mit
  ThisDrawing.Wblock Filename Auswahlsatz
kann ich doch nur neue Blöcke erstellen. Die Blöcke existieren bereits in der Zeichnung.

Vielen Dank!

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Hallo Willi,
ich verstehe dein Problem nicht ganz.
Du hast ein SelSet und möchtest daraus einen WBlock erstellen?
Was funktioniert daran nicht?

------------------
Roland

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

---

@Roland:
Ich habe eben kein SelectionSet. Die Blöcke sind in der Zeichnung bereits eingefügt. Ich will alle Blöcke aber als WBLOCK exportieren - und das in VBA. In LISP ist das eh kein Problem. Meine jetzige Möglichkeit ist über SendCommand "._wblock" ...., aber das ist nicht gerade eine saubere Lösung. Als entweder ich bekomme ein SelectionSet von einem Block nur über den Blocknamen oder ????

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Offensichtlic muß SelectionSet erzeugt werden,
die Objekte eines Blockes mit Block.Item(index)
in des SS einlesen, und mit Wblock speichern.

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

@Bernd:
Danke für Deine Antwort, habe soetwas befürchtet.

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

@Bernd:

Habe einen Auswahlsatz mit dem Blockobjekten gemacht, über

Thisdrawing.blocks(BLOCKNAME).item

hat aber nicht so recht funktioniert. Hast Du vielleicht ein Beispiel?

Danke!

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Public Sub Wblock()

    Dim ss As AcadSelectionSet
    Dim bs As AcadSelectionSet
    Dim iz, uz, vz As Integer
    Dim entity As AcadEntity
    Dim entitys As Variant
    Dim name As String
    Dim path As String
   
    On Error GoTo Ende
   
    Set ss = ThisDrawing.SelectionSets.Add("Blocks")
    Set bs = ThisDrawing.SelectionSets.Add("Wblocks")
   
    ss.SelectOnScreen

    iz = ss.Count
   
    For uz = 0 To iz - 1
        Set entity = ss.Item(uz)
        If entity.ObjectName = "AcDbBlockReference" Then
            name = entity.name
            path = "D:/" & name & ".dwg"
            entitys = entity.Explode
            bs.AddItems entitys
            ThisDrawing.Wblock path, bs
            bs.Delete
            bs.Clear
        End If
    Next

Ende:

    ss.Clear
    ss.Delete

End Sub

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

Hallo Bernd!

Vielen Dank! Aber das mit Ursprung und so ist recht gut, aber meine Blöcke haben auch Attribute, die ich noch brauch. Es sollte auch nicht die Zeichnung verändert werden. Es muß irgendwie auch ohne Ursprung gehen.

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Bei ursprung in vba bleibt die referenz selbst
erhalten, die zerlegten elemente werden exportiert,
und in der hauptzeichnung lösche ich sie wieder!?
(bs.delete)

wenn die neue zeichnung als block eingefügt
wird, wird ja nach den attributen gefragt.

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

Opps, sollte bs.Erase nicht bs.Delete
heißen

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

@Bernd:
Super!
Jetzt schauts so aus, wie wennŽs funktioniert!

Danke!

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Hallo Willi,

hier noch der Code mit dem du nur Blöcke wählen kannst.

Code:

---

    Dim SS As AcadSelectionSet
    Dim FltTypes(0) As Integer
    Dim FltData(0) As Variant
   
    ' Frage nach den zu bearbeitenden Blöcken
    Set SS = CreateSelectionSet("LinienlängeAuswahl")
    FltTypes(0) = 0: FltData(0) = "INSERT"
   
    ' Selectionset erstellen, Benutzer fragen und Filter anwenden
    SS.SelectOnScreen FltTypes, FltData

---

und hier die Funktion CreateSelectionSet, sie ist recht praktisch, Fehlermeldungen werden abgefangen.

Code:

---

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet
   
    Dim SS As AcadSelectionSet
   
    On Error Resume Next
    Set SS = ThisDrawing.SelectionSets(ssName)
    If Err Then Set SS = ThisDrawing.SelectionSets.Add(ssName)
    SS.Clear
    Set CreateSelectionSet = SS

End Function

---

Wenn du nämlich die Blöcke gleich gefiltert auswählst ersparst du dir die Abfrage ob die gewählten Elemente Blöcke sind und kannst daraus gleich den WBlock erstellen.

[Diese Nachricht wurde von RoSiNiNo am 05. März 2003 editiert.]

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

---

@Roland:

Vielen Dank!
Das Filtern der Blöcke ist kein Problem. Ich möchte eigentlich nur bereits in der Blocktabelle abgelegte, in der Zeichnung aber nicht eingefügte Blöcke als WBLOCK über VBA speichern. Der Umweg über den eingefügten Block mit Ursprung ist zwar eine Lösung, die Gut funktioniert, aber einen Auswahlsatz direkt aus der Blocktabelle wäre super. Vielleicht geht das auch nicht und ich habe einfach einen Denkfehler. Aber in Lisp geht es ja auch mit (command "._wblock" filename Blockname).

Grüße nach Wien

------------------
Grüße aus Linz

Willi Klemens
MCDS Datensystem GmbH

www.mcds.net

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

---

Erst mal schöne Grüße nach Linz, bin gestern vorbeigefahren, war nämlich in Windischgarsten auf Kurzurlaub.
Hier nocheinmal die Prozedur, schreibt alle Blöcke aus der Zeichnung in ein Verzeichnis.

Code:

---

Public Sub BlöckeAusZeichnung()
   
    Dim Blöcke As AcadBlocks
    Dim BlObj As AcadBlock
    Dim BlRef As AcadBlockReference
   
    Dim SS As AcadSelectionSet
   
    Dim Entitys As Variant
    Dim Name As String
    Dim Path As String
   
   
    Set Blöcke = ThisDrawing.Blocks
    If Blöcke.Count = 0 Then Exit Sub
   
    Set SS = CreateSelectionSet("Blöcke")
   
    For Each BlObj In Blöcke
        If Not (BlObj.IsLayout Or BlObj.IsXRef) Then
            Name = BlObj.Name
           
            Set BlRef = ThisDrawing.ModelSpace.InsertBlock(Point3D(0, 0, 0), Name, 1, 1, 1, 0)
           
            Path = "D:/" & Name & ".dwg"
            Entitys = BlRef.Explode
            SS.AddItems Entitys
            ThisDrawing.Wblock Path, SS
           
            SS.Erase
            SS.Clear
        End If
    Next BlObj
ENDE:
    SS.Delete

End Sub

---

------------------
Roland

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

---

Hallo Willi,
bin auf ein paar Fehler draufgekommen, hab sie nun bereinigt.
Bevor du die Blöcke erstellst solltest du aber ins WKS wechseln (ganz WICHTIG).
Leider muß man dann die Zeichnungen noch einmal öffnen und "plan" eingeben, nach dem speichern ist dann auch ein Vorschaubild zu sehen.

Code:

---

Public Sub BlöckeAusZeichnung()
   
    Dim Blöcke As AcadBlocks
    Dim BlObj As AcadBlock
    Dim BlRef As AcadBlockReference
   
    Dim ss As AcadSelectionSet
   
    Dim Entitys As Variant
    Dim Name As String
    Dim Path As String
   
   
    Set Blöcke = ThisDrawing.Blocks
    If Blöcke.Count = 0 Then Exit Sub
   
    Set ss = CreateSelectionSet("Blöcke")
   
    For Each BlObj In Blöcke
        If Not (BlObj.IsLayout Or BlObj.IsXRef) Then
            Name = BlObj.Name
           
            If InStr(Name, "*") > 0 Then GoTo NextObj
           
            Set BlRef = ThisDrawing.ModelSpace.InsertBlock(Point3D(0, 0, 0), Name, 1, 1, 1, 0)
           
            Path = "D:/_Buero/Zeichnungen/_Test/" & Name & ".dwg"
            Entitys = BlRef.Explode
            ss.AddItems Entitys
            On Error Resume Next
            ThisDrawing.Wblock Path, ss
            If Err Then
                Err.Clear
                MsgBox "Block """ & Name & """ kann nicht gespeichert werden!"
            End If
           
            BlRef.Delete
            ss.Erase
            ss.Clear
        End If
NextObj:
    Next BlObj
ENDE:
    ss.Delete

End Sub

---

------------------
Roland

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

---

Moin,

ich habe mich noch nie mit VBA auseinandergesetzt. Bisher habe ich immer Lisp-Dateien für extra Aufgaben genommen.

Da ich auch alle Blöcke aus einer Zeichnung als Wblock augeben möchte, habe ich Versucht den letzten VBA-Code von RoSiNo zum laufen zu bringen.

Also Text in den Zwischenspeicher -> rein in den Visual Basic Editor 8hatte das Ding zum ersten mal in meien Leben auf) -> den Pfad anpassen (und gleich meine erste Änderung in einen VBA-Code!) -> das ganze speichern -> vbaausf eingeben -> auf ausführen drücken -> Fehlermeldung empfangen

Folgende Fehlermeldung: Fehler beim Kompilieren: Sub oder Function nicht definiert

CreateSelectionSet ist Blau hinterlegt, die oberste Zeile ist gelb,

Was habe ich bloss wieder falsch gemacht?

------------------
Schöne Grüsse aus dem Norden

Molo

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

---

Die Funktion CreateSelectionSet findest du weiter oben
bei RoSiNiNo, die gehört auch ins Projekt reinkopiert

------------------
Bernd Cuder
Cad&Co makes CAD easy - z.B. Applikation für lineare Bemaßung

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

---

Ok, das habe ich verstanden.

Sämtliche Unterprogramme müssen in einem Projekt eingebunden sein.

Dafür läuft es jetz bis zu

Set BlRef = ThisDrawing.ModelSpace.InsertBlock(Point3D(0, 0, 0), Name, 1, 1, 1, 0)

Point3D ist wieder hinterlegt.

Ihr braucht mir jetzt nicht Programm stück für Stück mit mir durchgehen. Wenn es eben nicht bei mir Funktioniert habe ich eben Pech gehabt.

Aber auf jeden Fall habe ich erstmal gelernt, wie man überhaupt VBA-Programme läd.

Weiss jemand eine gut Internetseite zum VBA-lernen, ähnlich der von Axel für lisp.

------------------
Schöne Grüsse aus dem Norden

Molo

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

---

Code:

---

Public Function Point3D(x As Double, Y As Double, Optional z As Double = 0) As Variant

    Dim retVal(0 To 2) As Double
   
    retVal(0) = x: retVal(1) = Y: retVal(2) = z
   
    Point3D = retVal

End Function

---

Jetzt sollte aber alles da sein.
ein paar links:
http://www.afralisp.com/vba.htm
http://www.vb-seminar.de/index.htm

------------------
Roland

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

---

Klappt !!     

------------------
Schöne Grüsse aus dem Norden

Molo

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