Lisp: hatching region on current Layer should be on new layer

Lisp: hatching region on current Layer should be on new layer

t_ott
Contributor Contributor
665 Views
3 Replies
Message 1 of 4

Lisp: hatching region on current Layer should be on new layer

t_ott
Contributor
Contributor

Hello everyone,

I have the following problem:
This Lisp finds a region on the current layer and then creates a hatch.
This hatching should be placed on the newly created layer.
But unfortunately the hatching is placed on the current layer.
Can someone help me further?
Thank you Tom

(defun c:CreateHatchRegion ()
  (if (setq objLayer (getvar "clayer"))  ; Hole den aktuellen Layer
    (progn
      ;; Hole die Layer-Eigenschaften des aktuellen Layers
      (setq currentLayerData (tblsearch "LAYER" objLayer))
      (setq currentLayerColor (cdr (assoc 62 currentLayerData)))  ; Farbe des aktuellen Layers

      ;; Suche nach einer Region auf dem aktuellen Layer
      (setq sel (ssget "X" (list (cons 8 objLayer) (cons 0 "REGION"))))

      ;; Wenn eine Region gefunden wurde
      (if sel
        (progn
          (setq ent (ssname sel 0))  ; Wähle das erste gefundene Objekt
          
          ;; Erstelle eine SOLID-Schraffur auf der Region
          (command "_hatch" "SOLID" "1" "0" ent "")

          ;; Hole die zuletzt erstellte Schraffur
          (if (setq lastHatch (entlast))
            (progn
              ;; Setze die Transparenz auf 90%
              (command "_CHPROP" lastHatch "" "_transparency" "90" "")
            )
          )

          ;; Generiere den neuen Layernamen (aktueller Layer + "_Schraffur")
          (setq newLayer (strcat objLayer "_Schraffur"))

          ;; Überprüfe, ob der neue Layer bereits existiert
          (if (not (tblsearch "LAYER" newLayer))  ; Wenn der Layer nicht existiert
            (progn
              ;; Erstelle den Layer mit den gleichen Attributen wie der aktuelle Layer
              (command "._LAYER" "M" newLayer "_Color" currentLayerColor "")
            )
          )

          ;; Setze den Layer der Schraffur auf den neuen Layer
          (command "_CHPROP" lastHatch "" "_Layer" newLayer "")
          
          (princ "\nSchraffur mit Transparenz und dem neuen Layer erstellt.")
        )
      )
      (princ "\nKeine Region auf dem aktuellen Layer gefunden.")
    )
    (princ "\nKein aktueller Layer gefunden.")
  )
  (princ)  ; Beende die Ausgabe
)
0 Likes
Accepted solutions (1)
666 Views
3 Replies
Replies (3)
Message 2 of 4

paullimapa
Mentor
Mentor
Accepted solution

looks like you're missing an enter on this line of code:

              (command "._LAYER" "M" newLayer "_Color" currentLayerColor "")

change to this and it should work:

              (command "._LAYER" "_M" newLayer "_Color" currentLayerColor "" "")

But curious why you need this if statement since there is always a current layer that would exist:

  (if (setq objLayer (getvar "clayer"))  ; Hole den aktuellen Layer

 Also you may want to prefix the following with a period:

(command "_.hatch" "SOLID" "1" "0" ent "")
(command "_.CHPROP" lastHatch "" "_transparency" "90" "")
(command "_.CHPROP" lastHatch "" "_Layer" newLayer "")

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 3 of 4

t_ott
Contributor
Contributor
Great, thank you very much for that
0 Likes
Message 4 of 4

paullimapa
Mentor
Mentor

You are welcome…cheers!!!


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes