---

Hallo Forum,

kennt jemand eine Möglichkeit auf die Layer-Eigenschaft einer Blockdefintion in der Blocktabelle mit VBA zuzugreifen?
In der VBA-Objektbeschreibung fehlt diese Eigenschaft. In der Beschreibung der DXF-Gruppencodes wird diese Beschreibung aber aufgeführt und über Lisp kann mann auch darauf zugreifen:

Befehl: (entget(tblobjname "BLOCK" "*x8"))
((-1 . <Objektname: 7eff9478> ) (0 . "BLOCK") (330 . <Objektname: 7eff9470> ) (5
. "2297") (100 . "AcDbEntity") (67 . 0) (8 . "test") (100 . "AcDbBlockBegin")
(70 . 1) (10 0.0 0.0 0.0) (-2 . <Objektname: 7eff9480> ) (2 . "*X8") (1 . ""))

Der Eintrag (8. "test") enthält den Layer.

Schon mal vielen Dank im voraus.

------------------
mfg. P.Camehl

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

---

ich frage mich gerade, was hier eine Layerangabe überhaupt bringen soll ?

Erst die Einfügung eines Blockes liegt auf einem Layer. Der Blockdefinition selbst kann das doch ziemlich egal sein.

ich vermute eher das liegt daran. dass die Blockdefinition selbst eigentlich genauso als Entity gespeichert wird, und einfach einen Layer benötigt. Ganz kurios ist es, wenn der Block auf einen Layer liegt und das zugehörige Blockende auf einen anderen Layer.

[Diese Nachricht wurde von fuchsi am 11. Apr. 2006 editiert.]

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

---

Hallo fuchsi,

ja , das habe ich mich auch schon gefragt.
Mein Problem ist, dass ich den Layer nicht bereinigen kann, so lange er von einem Objekt referenziert wird. In diesem Fall eben von dieser Blockdefinition.

Wenn ich Dich richtig verstanden habe, kannst Du mir leider auch keine Lösung für mein Problem anbieten.

------------------
mfg. P.Camehl

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

---

Hallo,

lad dir doch mal das Tool. Hiermit kannst du deine Blöcke untersuchen. Es st auch der Code enthalten mit dem du die Layerdefinition der Blockentitys auslesen und ändern kannst.

Vielleicht geht's so

Code:

---

'' geändert !!
Sub test()
  BlockLayer ThisDrawing.ModelSpace.Layout.Block.Name, "0"
End Sub

Sub BlockLayer(Blockname As String, Layer As String)
Dim entity As AcadEntity
Dim Block As AcadBlock

    Set Block = ThisDrawing.Blocks(Blockname)
    For Each entity In Block
        entity.Layer = Layer

        If entity.ObjectName = "AcDbBlockReference" Then
          ' Rekursiv die Blockdefinitionen untersuchen
          BlockLayer entity.Name, Layer
        End If

    Next entity
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

---

temp4.zip

Hallo Stelli,

vielen Dank für Deine Antwort.
Das Tool kenne ich bereits.
Dein Code funktioniert zwar, aber in diesem speziellen Fall kommt leider nicht das gewünschte Ergebnis zustande.
Wenn Du möchtest, kannst Du es selber mal testen mit einer Zeichnung von mir.

------------------
mfg. P.Camehl

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

---

IMHO kann man den Layer im Blockheader nicht mit VBA und auch nicht mit der entmod-Funktion aus Lisp nachträglich ändern .. mit arx sollte was gehen.. eine Möglichkeit wäre die Blockneudefinition und anschließendes Kopieren der Blockelemente in den neuen Block, Zuweisung der neuen Definition an alle Referenzen des Ursprungsblockes, Bereinigung desselben und anschließendes Umbenennen des neuen Blockes auf den Namen des alten (nun bereinigten) ....

------------------
  - 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

---

Hallo,

geht in der Tat nicht mit VB. Wenn du die Datei als DXF speicherst, kannst du den Abschnitt der Layerdefinition suchen
AcDbLayerTableRecord
  2
AM_8
Wenn du danach alle AM_8 gegen 0 tauschst, kannst du nach dem Import der DXF den Layer AM_8 bereinigen.

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

---

es geht schon.
allerdings nicht mit entmode, sondern du musst den Block einfach neu erstellen

z.B.:

(setq bl (tblnext "BLOCK" t))

(while bl

  (setq blname (cdr (assoc 2 bl)))
  (setq en (tblobjname "BLOCK" blname))
  (setq ed (entget en))
  (entmake (subst (cons 8 "NeuerLayer") (assoc 8 ed) ed))

  (while (setq en (entnext en))
    (entmake (entget en))
  )
  (entmake (list (cons 0 "ENDBLK") (cons 8 "NeuerLayer")))
  (setq bl (tblnext "BLOCK"))
)

diese Routine duchrläuft die ganze Blockdefinitiontabelle und erstellt jede Blockdefinition neu. und hier akzeptiert er das Layer-Attribut

in diesem beipiel lege ich alle (0 . "BLOCK") auf den Layer NeuerLayer

->

(entget (tblobjname "BLOCK" "1"))
((-1 . <Objektname: 40227e60> ) (0 . "BLOCK") (330 . <Objektname: 4006dd68> ) (5
. "25CC") (100 . "AcDbEntity") (67 . 0) (8 . "NeuerLayer")(100 .
"AcDbBlockBegin") (70 . 0) (10 0.0 0.0 0.0) (-2 . <Objektname: 40227e68> ) (2 .
"1") (1 . "1"))

------------------

Ing. Anton Fuchs
WWW.FFZELL.AT.TC

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