---

Guten morgen zusammen,

wenn ich von einem Block den Layer auf AM_11 setze, dann werden nur die Linien auf AM_11 gesetzt, die den Layer 0 haben. Ich möchte aber genauso die anderen Layer auf den AM_11 setzen.

Es geht darum, wenn ich jetzt bsp. einen Klotz mit einem Außengewinde habe, der an eine BG angrenzt, so möchte ich diesen komplett auf den Layer AM_11 setzen, ohne ihn aufmachen zu müssen und die Linien zu ändern, da er auch noch "sichtbar" verwendet wird.

In der Hilfe habe ich dazu ein Thema gefunden, im dem es heißt, dass dies nicht möglich sei - aber es gibt ja sicherlich irgendwie eine Möglichkeit. sonst wäre das ganze Programm absolut nicht konstruktions-freundlich.

Gruß,

Oli.

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

---

..probiers mal mit diesem Lisp:

(defun C:SETLAYERFORBLOCKITEMS( / AUSWAHL INSERT BLOCK LAYER)
  (vl-load-com)
  (if(and(or(setq AUSWAHL (ssget "I"   '((0 . "INSERT"))))
            (setq AUSWAHL (ssget       '((0 . "INSERT"))))
         )
         (setq INSERT (ssname AUSWAHL 0))
         (setq BLOCK(vla-item(vla-get-blocks
                               (vla-get-ActiveDocument
                                 (vlax-get-acad-object)
                               )
                             )
                             (cdr(assoc 2(entget INSERT)))
                    )
         )
         (setq LAYER (getstring "\nAuf welchen Layer sollen die Blockelemente gesetzt werden? <0>"))
         (or(tblsearch "LAYER" LAYER)
            (setq LAYER "0")
         )  
     )
    (vlax-for Item BLOCK
      (vla-put-layer ITEM LAYER)     
    )
  )
  (vla-Regen(vla-get-activedocument(vlax-get-acad-object))acAllViewports) 
)

Falls du mit Lisp keine Erfahrungen hast, findest du hier wie du es laden kannst.

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

---

Super-Tipp! Aber das funktioniert nur bei Elementen!
Wie geht das auch mit Blöcken in Blöcken?

------------------
"Was ist das?"
"Blaues Licht!"
"Was macht es?"
"Es leuchtet blau!" (Rambo III)

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

---

Hallo Thomas!

Ich werde das "Lisp" einmal ausprobieren, hatter allerdings noch keine Zeit. Melde mich dann nochmals!

Gruß Oli.

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

---

Hallo!!

Diese Lisp ist ein Super Ding!!

Kann jemand diese Lisp erweitern?? Ich möchte nicht komplett alle Elemente in dem Block ändern, sondern nur Elemente die auf z.B. dem Layer AM_0 liegen...

Bevor diese Lisp die Elemente ändert, sollte ich gefragt werden welchen Layer ich in diesem Block ändern möchte!!

Kann dies jemand mit einbauen?? Es wäre für viele mit Sicherheit sehr hilfreich!!

Vielen Dank und schöne Grüße,
Christian Rupp

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

---

na ok, als "Begrüßungsgeschenk" sozusagen :

(defun C:SETLAYERFORBLOCKITEMS2( / AUSWAHL INSERT BLOCK LAYER OBJ OBJLAYER)
  (vl-load-com)
  (if(and(or(setq AUSWAHL (ssget "I"  '((0 . "INSERT"))))
            (setq AUSWAHL (ssget      '((0 . "INSERT"))))
        )
        (setq INSERT (ssname AUSWAHL 0))
        (setq BLOCK(vla-item(vla-get-blocks
                              (vla-get-ActiveDocument
                                (vlax-get-acad-object)
                              )
                            )
                            (cdr(assoc 2(entget INSERT)))
                    )
        )
        (setq LAYER (getstring "\nAuf welchen Layer sollen die Blockelemente gesetzt werden? <0>"))
        (or(tblsearch "LAYER" LAYER)
            (setq LAYER "0")
        )
        (or (/=(setq OBJLAYER (getstring "\nZu berücksichtigende Blockelementelayer? <von Objekt>"))"")
            (and (setq OBJ(car(nentsel)))
                  (setq OBJLAYER(cdr(assoc 8 (entget OBJ))))
            )
        )   
        (tblsearch "LAYER" OBJLAYER)
    )
    (vlax-for Item BLOCK     
      (if (=(strcase(vla-get-layer ITEM))(strcase OBJLAYER))
        (vla-put-layer ITEM LAYER)
      ) 
    )
  )
  (vla-Regen(vla-get-activedocument(vlax-get-acad-object))acAllViewports) 
)

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

---

Was für ein schönes Lisp! THX!

------------------
mfg Volker

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

---

Ja WAHNSINN!! Das ging aber schnell...

Vielen Dank für die Erweiterung!! Diese Lisp hilft mir und meinen Kollegen wirklich sehr!!

Gruß,
Christian Rupp

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

---

Suuuper Thomas,

ich hab mir noch einige Buttons mit den üblichen Layerwechseln
gemacht.
Jetzt kann ich mit einem Klick die Konturen auf
Phantom setzen.

Button wenn das Lisp schon geladen ist:
^C^CSETLAYERFORBLOCKITEMS2;\;AM_11;AM_0

Danke und Gruß Wolfgang

------------------
"Früher war die Zunkunft besser"
-Karl Valentin-

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

---

Hallo Thomas,

eine Frage bzw. Anregung hätte ich noch.

Ist es ein großer Aufwand wenn das Programm auch alle
Unterblöcke des gewählten Blocks bearbeitet?

Gruß Wolfgang

------------------
"Früher war die Zunkunft besser"
-Karl Valentin-

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

---

hallo Oli,

war auf der Suche nach derselben Aufgabenstellung
Mit Hikfe folgendem Werk wird alles im Block auf Phantomlayer modifiziert

mit freundlichem Gruss
Hans Krissler

Public Sub PhantomBlock()

Rem aktuelle Zeichnung
Dim Dok As AcadDocument
Set Dok = ThisDrawing.Application.ActiveDocument
DokName = Dok.Name

Rem Block selektieren
Dim Auswahl(0) As Object
On Error GoTo errhandler
ThisDrawing.Utility.GetEntity Auswahl(0), basepnt, vbCrLf & "Block auswählen: "
If Auswahl(0).ObjectName = "AcDbBlockReference" Then
    Dim AuswahlBlock As AcadBlockReference
    Set AuswahlBlock = Auswahl(0)
    Dim AuswahlBlockName As String
    AuswahlBlockName = AuswahlBlock.Name
    Dim InsertionPnt(0 To 2) As Double
    InsertionPnt(0) = AuswahlBlock.InsertionPoint(0)
    InsertionPnt(1) = AuswahlBlock.InsertionPoint(1)
    InsertionPnt(2) = AuswahlBlock.InsertionPoint(2)
   
    Rem Block-Manipulation wird in einer Dummy-Zeichnung ausgeführt
    Dim DokDummy As AcadDocument
    Set DokDummy = Documents.Add
   
    Rem Block in Dummy-Zeichnung
    Dim RetVal As Variant
    RetVal = Documents.Item(Dok.Name).CopyObjects(Auswahl, ThisDrawing.ModelSpace)
    ThisDrawing.Application.ZoomExtents
   
Rem kein Block ausgewählt
Else: MsgBox "Auswahl war kein Block", vbExclamation
GoTo errhandler
End If

Rem Block in Elemente zerlegen
Nochmal:
For Each Auswahl(0) In ThisDrawing.ModelSpace
    If (Auswahl(0).ObjectName = "AcDbBlockReference") Then
        Auswahl(0).Explode
        Auswahl(0).Delete
        Rem nach Blockzerlegung kann der Block nochmals einen Block enthalten :
        GoSub Nochmal
    End If
Next
Rem Zerlegung Schrauben und Sonstiges
ThisDrawing.SendCommand "_Explode" & vbCr & "Alle" & vbCr & vbCr

Rem AuswahlSatz Alles
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.SelectionSets.Add("Brutto")
SSet.Select acSelectionSetAll
Rem Objekte aus Auswahlsatz der Objektliste zuordnen
ReDim SSetListe(SSet.Count - 1) As Object
For i = 0 To SSet.Count - 1
    Set SSetListe(i) = SSet.Item(i)
Next

Rem beim Auflösen entstehen ominöse Objekte, die können wir einfach löschen
For i = 0 To SSet.Count - 1
   
    If SSet.Item(i).Layer = "-BHMU" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "BHII" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "BHMM" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "CENN" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "CON1" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "HIDN" Then
        SSet.Item(i).Delete
    ElseIf SSet.Item(i).Layer = "THLI" Then
        SSet.Item(i).Delete
    End If
Next

Rem LayerWechsel
ThisDrawing.SendCommand "_AMLayMove" & vbCr & "Alle" & vbCr & vbCr & "AM_11" & vbCr

Rem neuen Block (bestehend aus Phantom-Elementen) erstellen
Dim ReBlock(0) As Object
Set ReBlock(0) = ThisDrawing.Blocks.Add(InsertionPnt, "Phantom-" & AuswahlBlockName)
Dim ReBlockName As String
ReBlockName = ReBlock(0).Name
Set SSet = ThisDrawing.SelectionSets.Add("Netto")
SSet.Select acSelectionSetAll

Rem Objekte aus Auswahlsatz der Objektliste zuordnen
ReDim SSetListe(SSet.Count - 1) As Object
For i = 0 To SSet.Count - 1
    Set SSetListe(i) = SSet.Item(i)
Next

Rem aus oben gebildetem Auswahlsatz den "Phantom-Block" erstellen
RetVal = DokDummy.CopyObjects(SSetListe, ReBlock(0))

Rem Phantom-Block zurück in Ausgangszeichnung kopieren
RetVal = Documents.Item(DokDummy.Name).CopyObjects(ReBlock, Dok.ModelSpace)

Rem Ursprungs-Zeichnung aktivieren
Dok.Activate

Rem Dummy-Zeichnung schliessen
DokDummy.Close

Rem Phantom-Block einfügen
Set ReBlock(0) = ThisDrawing.ModelSpace.InsertBlock(InsertionPnt, ReBlockName, 1, 1, 1, 0)

Rem Ursprungs-Block löschen
AuswahlBlock.Delete

Rem ein paarmal Bereinigen ausführen
For i = 1 To 4
    ThisDrawing.PurgeAll
Next i

errhandler:

End Sub

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

---

hallo,
wir haben folgendes Problem mit den LSP, es bezieht sich immer auf
einem ausgewählten Block. Für uns wäre es besser, wenn es sich auf
alle Blöcke der gesamten Zeichnung bezieht.
Als zweites wird nur der Layer geändert ist ja so auch gewollt nur
der Linientyp und die Farbe sollte außerdem noch auf "von Layer" zurück gesetzt wird.
Richtig super wäre dann noch, wenn noch statt der Abfrage Blocklayer als Auswahlpunkt die Abfrage des Blocklinietyp kämen.

Danke im voraus

Frank

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

---

SETPROPSFORBLOCKITEMS.VLX.txt

Hi Frank, anbei was zum testen, Keine Ahnung, ob's das trifft, oder ob du ne generelle Layer/Ltype/Farb anpassung willst, Dafür fehlt noch etwas an Input  .

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

---

zweischnextruder.zip

hallo,

danke aber ich glaube so wird das nicht.
Ich schicke dir hier mal eine Beispielzeichnung, an der
wird das problem wohl besser klar.
Die Blockstruktur soll so erhalten bleiben aber die Layerstruktur
von allen Blöcken geändert werden.
1)
Linientyp: Continuous  und Farbe: Weiß
auf
Layer 0 mit  Linientyp: von Layer  und Farbe: von Layer
2)
Linientyp: Center  und Farbe: Weiß
auf
Layer AM_7 mit  Linientyp: von Layer  und Farbe: von Layer

bis dann

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

---

Ach so... Naja, auch technisch kein Problem, wird von mir aber programmtechnisch nicht im Rahmen einer "Hilfestellung" gelöst werden. Sorry.

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