36 lines
1.4 KiB
Common Lisp
36 lines
1.4 KiB
Common Lisp
;; sepHatch.lsp
|
|
;;
|
|
;; Move all hatches in the drawing to a new layer. Hatches on a frozen layer are omitted
|
|
;;
|
|
;; Created by Peter Gyetvai
|
|
;; gyetpet@mailbox.org
|
|
|
|
; ----------------- 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)
|
|
)
|