---

Hallo zusammen,

ich habe einen VBA-Code der mir nach Anklicken eines Icons einen Block in meine Zeichnung einfügt. Der Block wird aus einer DWG-Bibliothek (eigener Ordner mit vielen Blöcken) geholt.
Das funktioniert.

Wie kann ich den Block im Ursprung einfügen?

In Lisp würde ich dem Blocknamen einfach ein "*" voranstellen und der Block würde im Ursprung (gesprengt) eingefügt.
?

------------------
Christian

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

---

Hi,

Code:

---

Dim tBlRef as AcadBlockReference

'dann machst Du Deinen Einfügevorgang

Dim tExplodedEnts as Variant
tExplodedEnts = tBlRef.Explode

---

- alfred -

PS: ein Beispiel wäre auch schon >>>hier<<< vorhanden

------------------
www.hollaus.at

---

Danke Alfred,

für den Tipp.

------------------
Christian

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

---

Hi alfred,

funktioniert einwandfrei.
Noch eine kleine Nachfrage:
Es gibt den Befehl _explode und _xplode.

Ich hätte beim Zerlegen in den Ursprung gerne, dass die zerlegten Blockobjekte den Einfügelayer und alle anderen Eigenschaften beibehält (gezeichnet sind meine Blöcke alle auf Layer 0, Farbe VonBlock, Linien VonBlock, ...)
In der Befehlszeile wäre das _xplode H.

Wie drücke ich das in VB aus?

------------------
Christian

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

---

du liest die Einfügeparamter ( wird sicher aktueller Layer ect. sein) aus und weißt diese Eigenschaft dann den tExplodedEnts zu

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hi CADmium,

deine Vermutung ist richtig, nur weiß ich noch nicht wie das geht.
Ich habe derzeit beim vorherigen Schritt noch ein Problem.

Löse ich den Block auf mit "...Explode", dann habe ich schön die Einzelteile, aber auch die ursprüngliche Blockreferenz ist noch da.
Muss ich die extra löschen mit "...Delete"?

------------------
Christian

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

---

Hi,

>> Muss ich die extra löschen mit "...Delete"

...fast, zum Löschen brauchst Du die Methode '.Erase'

>> nur weiß ich noch nicht wie das geht.

Code:

---

Dim tEnt as AcadEntity
For Each tEnt in tExplodedEnts
  tEnt.Layer = tBlRef.Layer    'wobei tBlRef die ursprüngliche Blockreferenz ist
  tEnt.Color = tBlRef.Color
  tEnt.Lineweight = tBlRef.Lineweight
  tEnt.Linetype = tBlRef.Linetype
Next
tBlRef.Erase

---

HTH, - alfred -

------------------
www.hollaus.at

---

Hi alfred,

ich habe folgendes geschrieben:

Code:

---

'Blockreferenz einfügen, die schon in der Zeichnung vorhanden ist.
    Dim BlkRef As AcadBlockReference '
    'Unterscheiden, ob im Modelbereich oder im Layout eingefügt wird.
    If ThisDrawing.ActiveSpace = acModelSpace Then
        Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(EPkt, BlkNameAG, XF, YF, ZF, RiWi)
    Else
        Set BlkRef = ThisDrawing.PaperSpace.InsertBlock(EPkt, BlkNameAG, XF, YF, ZF, RiWi)
    End If
   
    'Eingefügte Blockreferenz in den Ursprung zerlegen.
    If UrsprungJN = True Then
        Dim tExplodedEnts As Variant
        Dim tEnt As Variant
       
        tExplodedEnts = BlkRef.Explode
       
        For Each tEnt In tExplodedEnts
            tEnt.Layer = BlkRef.Layer
            tEnt.color = BlkRef.color
            tEnt.Lineweight = BlkRef.Lineweight
            tEnt.Linetype = BlkRef.Linetype
        Next
        BlkRef.Erase
       
        MsgBox "Blockreferenz wurde in den Ursprung zerlegt.", vbInformation, "BlkInsert"
    End If

---

Wenn ich tEnt als Variant definiere läuft das Programm durch, ergibt aber noch nicht das richtige Ergebnis.

Ich habe vergessen zu sagen, dass die zu sprengenden Blöcke meist mehrere Layer enthalten und nur die Objekte, die im Block auf dem Layer 0 gezeichnet sind oder die Eigenschaft VonBlock haben, sollen die Eigenschaften der Blockreferenz erhalten, die anderen Teilobjekte sollen Ihre Eigenschaften behalten.

------------------
Christian

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

---

Hab's

Code:

---

For Each tEnt In tExplodedEnts
            If tEnt.Layer = "0" Then
                tEnt.Layer = BlkRef.Layer
                tEnt.color = BlkRef.color
                tEnt.Lineweight = BlkRef.Lineweight
                tEnt.Linetype = BlkRef.Linetype
            End If
        Next

---

------------------
Christian

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

---

Hi,

>> Wenn ich tEnt als Variant definiere

...wieso definierst Du diese als 'Variant' und nicht als 'AcadEntity'?

>> ....nur die Objekte, die im Block auf dem Layer 0 gezeichnet sind
>> oder die Eigenschaft VonBlock ...

...dann prüfe bitte vor Eigenschaftsänderung, ob das Deinen Kriterien entspricht! Das sollte doch nicht das Problem sein, zumindest nicht, wenn ich die Frage richtig interpretiere 

Code:

---

if tEnt.Layer = "0" then tEnt.Layer = BlkRef.Layer

---

- alfred -

------------------
www.hollaus.at

---

Hier nochmal mit Berücksichtung aller 3 Eigenschaften

Code:

---

'Block einfügen, wenn er schon in der Zeichnung vorhanden ist.
    Dim BlkRef As AcadBlockReference ' !!! Blockreferenz, d.h. der Block muss bereits in der Zeichnung definiert sein
   
    If ThisDrawing.ActiveSpace = acModelSpace Then
        Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(EPkt, BlkNameAG, XF, YF, ZF, RiWi)
    Else
        Set BlkRef = ThisDrawing.PaperSpace.InsertBlock(EPkt, BlkNameAG, XF, YF, ZF, RiWi)
    End If
   
    'Eingefügte Blockreferenz in den Ursprung zerlegen.
    If UrsprungJN = True Then
        Dim tExplodedEnts As Variant
        Dim tEnt As Variant
       
        tExplodedEnts = BlkRef.Explode
       
        For Each tEnt In tExplodedEnts
            If tEnt.Layer = "0" Then
                tEnt.Layer = BlkRef.Layer
                tEnt.color = BlkRef.color
            End If
            If tEnt.Lineweight = -2 Then '"VonBlock"
              tEnt.Lineweight = -1 '"VonLayer"
            Else
              tEnt.Lineweight = BlkRef.Lineweight
            End If
            If tEnt.Linetype = -2 Then '"VonBlock"
                tEnt.Linetype = -1 '"VonLayer"
            Else
                tEnt.Linetype = BlkRef.Linetype
            End If
        Next
        BlkRef.Erase
       
        MsgBox "Blockreferenz wurde in den Ursprung zerlegt.", vbInformation, "BlkInsert"
    End If

---

Vielen Dank für das Auf-die-Sprünge-Helfen

------------------
Christian

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

---

Hi alfred,
mit AcadEntity gibt er mir einen Fehler aus.
Deshalb difiniere ich es als Variant, damit geht es.

------------------
Christian

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