added sephatch.lsp

sepHatch.lsp

@@ -0,0 +1,42 @@
+;; 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
+
+(defun C:sephatch (/ ss i il imax currElem layerName newLayerName layerSettings newLayerSettings newLayer newElem)
+    (graphscr)
+
+    (setq ss (ssget "_A" '((0 . "HATCH"))))
+    (setq il (sslength ss));length of selection
+    
+    ;while variables:
+    (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)
+        
+    
+        ;while specific: 
+        (setq i (1+ i));increments i
+        (if (= i il) (setq imax nil));finish function if i equals il
+    )
+(princ)
+)