added sephatch.lsp

source scripts/sepHatch.lsp

@@ -0,0 +1,36 @@
+;; sepHatch.lsp
+;;
+;; Move all hatches in the drawing to a new layer. Hatches on a frozen layer are omitted
+;;
+;; Created by Peter Gyetvai
+;; gyetpet@gmail.com
+;; gyetvai-peter.hu
+
+; ----------------- sepHatch.lsp: Move hatches to new layers ----------------- ;
+(defun C:sephatch (/ ss i il imax currElem layerName newLayerName layerSettings newLayerSettings newLayer newElem)
+    (graphscr)
+    (setq ss (ssget "_A" '((0 . "HATCH"))))
+    (if ss
+      (progn
+        (setq il (sslength ss));length of selection
+        (setq i 0);counter to zero
+        (setq imax 1);while variable
+        (while imax 
+            (setq currElem (entget (ssname ss i) ))
+            (setq layerName (cdr (assoc 8 currElem)))
+            (setq newLayerName (strcat layerName "-hatch"))
+            (command "._-layer" "_M" newLayerName "")
+            (setq layerSettings (entget (tblobjname  "LAYER" layerName)))
+            (setq newLayerSettings (entget (tblobjname  "LAYER" newLayerName)))
+            (setq newLayer (subst (cons 62 (cdr (assoc 62 layerSettings))) (assoc 62 newLayerSettings) newLayerSettings))
+            (setq newLayer (subst (cons 70 (cdr (assoc 70 layerSettings))) (assoc 70 newLayer) newLayer))
+            (entmod newLayer)
+            (setq newElem(subst (cons 8 newLayerName) (assoc 8 currElem) currElem))
+            (entmod newElem)
+            (setq i (1+ i));increments i
+            (if (= i il) (setq imax nil));finish function if i equals il
+        )
+      )
+    )
+(princ)
+)