;;; --------------------------------------------------------------------------- ;;; LayerStack.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; Controls DRAW ORDER by layer - which layer's objects are drawn in front of ;;; which. ;;; ;;; AutoCAD's DRAWORDER command works on selected objects. That is no use when ;;; the rule you actually want is "hatching behind everything, text in front of ;;; everything, survey base at the very back" - a rule about layers, not about ;;; particular objects. ;;; ;;; This gives you a two-pane dialog: all layers on the left, the ones you want ;;; ordered on the right. Arrange the right-hand list into the order you want, ;;; then send that whole stack to the top or the bottom of the drawing. ;;; ;;; The order of the right-hand list IS the resulting draw order: the top of ;;; the list ends up in front. ;;; ;;; WILDCARD GROUPS ;;; The Add Pattern box accepts a wildcard, so "*HATCH*" adds every hatch layer ;;; as a single entry in the ordering list. That keeps a long layer standard ;;; manageable - you order half a dozen patterns rather than eighty layers. ;;; ;;; The Filter box narrows the left-hand list the same way, which is how you ;;; find layers in a drawing that has hundreds. ;;; ;;; Xref-dependent layers are excluded; their draw order belongs to the ;;; referenced drawing. ;;; ;;; HOW DRAW ORDER IS ACTUALLY SET ;;; Draw order lives in a SORTENTS table hanging off the space's extension ;;; dictionary, and objects are moved within it. The table is created if the ;;; drawing does not have one yet. ;;; ;;; The layer list is processed in REVERSE when sending to the top, because ;;; each MoveToTop puts that layer in front of everything moved before it - so ;;; the last one moved ends up frontmost. Reversing makes the first entry in ;;; your list finish in front, which is what the display implies. ;;; ;;; LAYERSTACK - set draw order by layer ;;; --------------------------------------------------------------------------- (vl-load-com) ;; --------------------------------------------------------------------------- ;; LayerStack:Doc - cached active document ;; --------------------------------------------------------------------------- (defun LayerStack:Doc nil (eval (list 'defun 'LayerStack:Doc 'nil (vla-get-activedocument (vlax-get-acad-object)) ) ) (LayerStack:Doc) ) ;; --------------------------------------------------------------------------- ;; LayerStack:SavePath ;; --------------------------------------------------------------------------- ;; Returns where the dialog definition file is kept. ;; ;; Unlike most routines here, this one writes its DCL to a PERMANENT location ;; rather than a temp file, and reuses it on later runs. The dialog is large ;; enough that rewriting it every time would be wasteful. ;; ;; Three fallbacks: the roamable Support folder, wherever ACAD.pat was found, ;; and finally the temp folder. ;; --------------------------------------------------------------------------- (defun LayerStack:SavePath ( / tmp ) (cond ( (setq tmp (getvar 'roamablerootprefix)) (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" tmp)) "\\Support") ) ( (setq tmp (findfile "ACAD.pat")) (vl-string-right-trim "\\" (vl-string-translate "/" "\\" (vl-filename-directory tmp))) ) ( (vl-string-right-trim "\\" (vl-filename-directory (vl-filename-mktemp)))) ) ) ;; --------------------------------------------------------------------------- ;; LayerStack:WriteDcl ;; --------------------------------------------------------------------------- ;; Writes the dialog definition, unless it is already there. Returns the ;; filename. ;; ;; The dialog names "layerstack" and "layerstackhelp" must agree between this ;; text and the new_dialog calls further down. ;; --------------------------------------------------------------------------- (defun LayerStack:WriteDcl ( fname / ofile ) (cond ( (findfile fname)) ( (setq ofile (open fname "w")) (foreach line '( "//------------------------------------------------------------//" "// Layer Draw Order - dialog definition //" "// Written automatically by LayerStack.lsp //" "//------------------------------------------------------------//" "" "arrowbox : image_button { width = 4.17; height = 1.92; fixed_width = true; fixed_height = true; color = dialog_background; }" "arrowimg : image { width = 4.17; height = 1.92; fixed_width = true; fixed_height = true; color = dialog_background; }" "listbox : list_box { width = 35; fixed_width = true; height = 20; fixed_height = true; multiple_select = true; }" "editbox : edit_box { width = 35; fixed_width = true; }" "button12 : button { width = 12; fixed_width = true; }" "button20 : button { width = 20; fixed_width = true; height = 2.1; fixed_height = true; }" "ctext : text { width = 80; fixed_width = true; alignment = centered; }" "ltext : text { width = 75; fixed_width = true; height = 1.3; fixed_height = true; alignment = centered; }" "btext : image { width = 19; fixed_width = true; height = 1.2; fixed_height = true; color = dialog_background; }" "" "layerstack : dialog { key = \"dcltitle\";" " spacer;" " : row {" " : boxed_column { label = \"All Layers\";" " : listbox { key = \"layer1\"; }" " : editbox { key = \"filter\"; label = \"Filter: \"; }" " spacer;" " }" " : column { fixed_height = true;" " : arrowbox { key = \"add\"; }" " : arrowbox { key = \"del\"; }" " }" " : boxed_column { label = \"Layers to Order (top of list = in front)\";" " : listbox { key = \"layer2\"; }" " : editbox { key = \"pattern\"; label = \"Add Pattern:\"; }" " spacer;" " }" " : column { fixed_height = true;" " : arrowbox { key = \"top\"; }" " : arrowbox { key = \"up\"; }" " : arrowbox { key = \"down\"; }" " : arrowbox { key = \"bottom\"; }" " }" " }" " spacer;" " : row { fixed_width = true; alignment = centered;" " : button20 { label = \"Move to Top\"; key = \"totop\"; is_default = true; }" " : button20 { label = \"Move to Bottom\"; key = \"tobottom\"; }" " }" " : row { fixed_width = true; alignment = centered;" " : button12 { label = \"Cancel\"; key = \"cancel\"; is_cancel = true; alignment = centered; }" " : button12 { label = \"Help\" ; key = \"help\"; alignment = centered; }" " }" "}" "" "layerstackhelp : dialog { key = \"dcltitle\";" " : btext { key = \"title1\"; alignment = centered; }" " spacer;" " : paragraph {" " : text_part { value = \"Controls the draw order of all objects on chosen layers.\"; }" " spacer;" " : text_part { value = \"The left-hand list shows every layer in the drawing, excluding xref-dependent layers.\";} " " : text_part { value = \"Select layers there and press the right arrow to add them to the ordering list.\"; }" " : text_part { value = \"The left arrow removes them again.\"; }" " spacer;" " : text_part { value = \"To find layers in a large drawing, type a wildcard in the Filter box and press Enter.\"; }" " : text_part { value = \"Clear the box and press Enter to remove the filter.\"; }" " spacer;" " : text_part { value = \"A whole GROUP of layers can be ordered as one entry: type a wildcard such as *HATCH*\"; }" " : text_part { value = \"in the Add Pattern box and press Enter.\";}" " spacer;" " : text_part { value = \"The order of the right-hand list is the resulting draw order - the top of the list ends\"; }" " : text_part { value = \"up in front. Use the arrow controls to rearrange it.\"; }" " spacer;" " : text_part { value = \"Press Move to Top to bring the whole stack in front of everything else in the drawing,\"; }" " : text_part { value = \"or Move to Bottom to send it behind everything else.\";}" " spacer_1;" " : btext { key = \"title2\"; alignment = left; }" " : row {" " : arrowimg { key = \"add\"; }" " : ltext { value = \"Add the selected layers to the ordering list.\"; }" " }" " : row {" " : arrowimg { key = \"del\"; }" " : ltext { value = \"Remove the selected layers from the ordering list.\"; }" " }" " : row {" " : arrowimg { key = \"top\"; }" " : ltext { value = \"Move the selected layers to the top of the ordering list.\"; }" " }" " : row {" " : arrowimg { key = \"up\"; }" " : ltext { value = \"Move the selected layers up one place.\"; }" " }" " : row {" " : arrowimg { key = \"down\"; }" " : ltext { value = \"Move the selected layers down one place.\"; }" " }" " : row {" " : arrowimg { key = \"bottom\"; }" " : ltext { value = \"Move the selected layers to the bottom of the ordering list.\"; }" " }" " }" " spacer_1; ok_only;" "}" "//------------------------------------------------------------//" ) (write-line line ofile) ) (setq ofile (close ofile)) ;; Wait for the file system to catch up - load_dialog on a file not ;; yet flushed fails intermittently. (while (not (findfile fname))) fname ) ) ) ;;; --------------------------------------------------------------------------- ;;; LIST REORDERING ;;; ;;; Each function takes the selected INDICES and the list, and returns ;;; (newIndices newList) - the list rearranged, and where the selection has ;;; moved to, so it can stay selected after the move. ;;; --------------------------------------------------------------------------- ;; Removes items by index. (defun LayerStack:RemoveItems ( i l / j ) (setq j -1) (vl-remove-if (function (lambda ( x ) (member (setq j (1+ j)) i))) l) ) ;; --------------------------------------------------------------------------- ;; LayerStack:MoveUp ;; --------------------------------------------------------------------------- ;; Moves the selected items up one place. ;; ;; The inner walker steps through the list keeping a countdown of how far each ;; selected index still is from the current position. When a countdown reaches ;; 0 the item is at the front already and cannot rise; at 1 it swaps with the ;; item before it. Anything else passes through untouched. ;; ;; Handling it as a countdown rather than by repeated searching is what lets a ;; block of adjacent selected items move up together without leapfrogging one ;; another. ;; --------------------------------------------------------------------------- (defun LayerStack:MoveUp ( i l / LayerStack:Walk ) (defun LayerStack:Walk ( a b c d e ) (cond ( (or (null b) (null c)) (list (reverse d) (append (reverse e) c)) ) ;; Already at the front - cannot move up. ( (= 0 (car b)) (LayerStack:Walk (1+ a) (mapcar '1- (cdr b)) (cdr c) (cons a d) (cons (car c) e)) ) ;; One place down - swap with the item before it. ( (= 1 (car b)) (LayerStack:Walk (1+ a) (mapcar '1- (cdr b)) (cons (car c) (cddr c)) (cons a d) (cons (cadr c) e)) ) ( t (LayerStack:Walk (1+ a) (mapcar '1- b) (cdr c) d (cons (car c) e)) ) ) ) (LayerStack:Walk 0 i l nil nil) ) ;; --------------------------------------------------------------------------- ;; LayerStack:MoveDown ;; --------------------------------------------------------------------------- ;; Moves the selected items down one place - by reversing the list, moving them ;; UP, and reversing back. Indices are mirrored on the way in and out. ;; ;; Reusing the move-up logic this way avoids writing and maintaining a second ;; near-identical walker. ;; --------------------------------------------------------------------------- (defun LayerStack:MoveDown ( i l ) (apply (function (lambda ( a b ) (list (reverse (mapcar (function (lambda ( x ) (- (length l) x 1))) a)) (reverse b) ) ) ) (LayerStack:MoveUp (reverse (mapcar (function (lambda ( x ) (- (length l) x 1))) i)) (reverse l) ) ) ) ;; Moves the selected items to the top, in their existing relative order. (defun LayerStack:MoveTop ( i l / j ) (setq j -1) (list (mapcar (function (lambda ( x ) (setq j (1+ j)))) i) (append (mapcar (function (lambda ( x ) (nth x l))) i) (LayerStack:RemoveItems i l) ) ) ) ;; Moves the selected items to the bottom. (defun LayerStack:MoveBottom ( i l / j ) (setq j (- (length l) (length i) 1)) (list (mapcar (function (lambda ( x ) (setq j (1+ j)))) i) (append (LayerStack:RemoveItems i l) (mapcar (function (lambda ( x ) (nth x l))) i) ) ) ) ;; --------------------------------------------------------------------------- ;; Dialog helpers. ;; --------------------------------------------------------------------------- (defun LayerStack:MakeList ( key lst ) (start_list key) (mapcar 'add_list lst) (end_list) ) ;; A list box selection arrives as "0 2 5"; bracketing and reading it gives a ;; list of integers, and the reverse converts a list back to that form. (defun LayerStack:ToIndices ( val ) (read (strcat "(" val ")"))) (defun LayerStack:ToValue ( lst ) (vl-string-trim "()" (vl-princ-to-string lst))) ;; --------------------------------------------------------------------------- ;; LayerStack:ArrowTiles ;; --------------------------------------------------------------------------- ;; Draws the six arrow buttons. ;; ;; DCL has no icon support, so each arrow is drawn as a series of vectors. Each ;; entry holds four parallel lists - x positions, start values, end values and ;; colours - which are walked together by mapcar, one vector per column or row. ;; ;; The two groups differ in orientation: the first four are VERTICAL arrows, ;; drawn as vertical strokes across a horizontal span; the last two are ;; HORIZONTAL, drawn as horizontal strokes down a vertical span. That is why ;; the two vector_image calls take their arguments in a different order. ;; ;; Colours 174 and 178 are the two shades that give the arrows their bevelled ;; appearance. ;; --------------------------------------------------------------------------- (defun LayerStack:ArrowTiles nil ;; Vertical arrows: top, up, down, bottom. (foreach v '( ("top" (001 001 002 002 003 003 004 004 005 005 006 006 007 007 008 008 009 009 010 010 011 011 012 012 013 013 014 014 015 015 016 016 017 017 018 018 019 019 020 020 021 021 022 022 023 023 024 024) (016 003 016 003 016 003 016 003 016 003 016 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 025 003 016 003 016 003 016 003 016 003 016 003 016 003) (015 000 014 000 013 000 012 000 011 000 010 000 009 000 008 000 007 000 006 000 005 000 004 000 004 000 005 000 006 000 007 000 008 000 009 000 010 000 011 000 012 000 013 000 014 000 015 000) (174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178) ) ("up" (001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024) (016 016 016 016 016 016 025 025 025 025 025 025 025 025 025 025 025 025 016 016 016 016 016 016) (015 014 013 012 011 010 009 008 007 006 005 004 004 005 006 007 008 009 010 011 012 013 014 015) (174 174 174 174 174 174 174 174 174 174 174 174 178 178 178 178 178 178 178 178 178 178 178 178) ) ("down" (001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024) (009 009 009 009 009 009 000 000 000 000 000 000 000 000 000 000 000 000 009 009 009 009 009 009) (010 011 012 013 014 015 016 017 018 019 020 021 021 020 019 018 017 016 015 014 013 012 011 010) (174 174 174 174 174 174 174 174 174 174 174 174 178 178 178 178 178 178 178 178 178 178 178 178) ) ("bottom" (001 001 002 002 003 003 004 004 005 005 006 006 007 007 008 008 009 009 010 010 011 011 012 012 013 013 014 014 015 015 016 016 017 017 018 018 019 019 020 020 021 021 022 022 023 023 024 024) (009 022 009 022 009 022 009 022 009 022 009 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 000 022 009 022 009 022 009 022 009 022 009 022 009 022) (010 025 011 025 012 025 013 025 014 025 015 025 016 025 017 025 018 025 019 025 020 025 021 025 021 025 020 025 019 025 018 025 017 025 016 025 015 025 014 025 013 025 012 025 011 025 010 025) (174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 174 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178) ) ) (start_image (car v)) (apply 'mapcar (cons '(lambda ( x y z c ) (vector_image x y x z c)) (cdr v))) (end_image) ) ;; Horizontal arrows: add and remove. (foreach v '( ("add" (011 011 011 011 011 011 002 002 002 002 002 002 002 002 002 002 002 002 011 011 011 011 011 011) (001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024) (012 013 014 015 016 017 018 019 020 021 022 023 023 022 021 020 019 018 017 016 015 014 013 012) (174 174 174 174 174 174 174 174 174 174 174 174 178 178 178 178 178 178 178 178 178 178 178 178) ) ("del" (014 014 014 014 014 014 023 023 023 023 023 023 023 023 023 023 023 023 014 014 014 014 014 014) (001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024) (013 012 011 010 009 008 007 006 005 004 003 002 002 003 004 005 006 007 008 009 010 011 012 013) (174 174 174 174 174 174 174 174 174 174 174 174 178 178 178 178 178 178 178 178 178 178 178 178) ) ) (start_image (car v)) (apply 'mapcar (cons '(lambda ( x y z c ) (vector_image x y z y c)) (cdr v))) (end_image) ) (princ) ) ;; --------------------------------------------------------------------------- ;; LayerStack:Help ;; --------------------------------------------------------------------------- ;; Shows the help dialog, with underlined section headings drawn as vectors - ;; DCL has no text styling of its own. ;; --------------------------------------------------------------------------- (defun LayerStack:Help ( id title ) (cond ( (not (new_dialog "layerstackhelp" id)) (alert "The help dialog could not be loaded.") ) ( t (LayerStack:ArrowTiles) (set_tile "dcltitle" title) (set_tile "title1" "Layer Draw Order") (start_image "title1") (vector_image 0 (1- (dimy_tile "title1")) (dimx_tile "title1") (1- (dimy_tile "title1")) 0) (end_image) (set_tile "title2" "Controls") (start_image "title2") (vector_image 0 (1- (dimy_tile "title2")) (dimx_tile "title2") (1- (dimy_tile "title2")) 0) (end_image) (start_dialog) ) ) ) ;; --------------------------------------------------------------------------- ;; LayerStack:Apply ;; --------------------------------------------------------------------------- ;; Applies the draw order to the drawing. ;; ;; doc - [vla-object] the document ;; layers - [list] layer names or wildcard patterns, front-most first ;; toTop - [boolean] T to bring them in front of everything else ;; --------------------------------------------------------------------------- (defun LayerStack:Apply ( doc layers toTop / LayerStack:SortEntsTable LayerStack:SafeArrayVariant ) ;; The SORTENTS table holds the draw order for a space. It is created on ;; demand - a drawing that has never had its draw order changed does not ;; have one. (defun LayerStack:SortEntsTable ( space / dict result ) (cond ( (not (vl-catch-all-error-p (setq result (vl-catch-all-apply 'vla-item (list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS") ) ) ) ) result ) ( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable")) ) ) (defun LayerStack:SafeArrayVariant ( datatype data ) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray datatype (cons 0 (1- (length data)))) data ) ) ) ( (lambda ( sortents func / ss ) ;; Reversed when sending to the top - see the note in the header. (foreach x (if toTop (reverse layers) layers) (if (setq ss (ssget "_X" (list (cons 8 x) (cons 410 (getvar 'CTAB))))) ( (lambda ( / l i ) (repeat (setq i (sslength ss)) (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)) ) (func sortents (LayerStack:SafeArrayVariant vlax-vbobject l)) ) ) ) ) ) (LayerStack:SortEntsTable (vlax-get-property doc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)) ) (if toTop vla-movetotop vla-movetobottom) ) (princ) ) ;; --------------------------------------------------------------------------- ;; c:LAYERSTACK - main routine ;; --------------------------------------------------------------------------- (defun c:LAYERSTACK ( / *error* vars vals dclid dclfname dcltitle hlptitle layers layer1 layer2 value1 value2 pattn filt1 filt2 savepath dflag x ) (setq vars '("CMDECHO") vals (mapcar 'getvar vars) ) (defun LayerStack:Restore ( ) (if (and dclid (< 0 dclid)) (unload_dialog dclid)) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End") (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) ) (princ) ) (defun *error* ( msg ) (LayerStack:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** LAYERSTACK error: " msg " **")) ) (princ) ) (setvar "CMDECHO" 0) (setq savepath (LayerStack:SavePath)) (cond ( (not (vl-file-directory-p savepath)) (princ "\nNo valid folder was found to write the dialog file to.") ) ( (progn (setq dclfname (strcat savepath "\\YZ_LayerStack.dcl") dcltitle "Layer Draw Order" hlptitle "Layer Draw Order - Help" ) (not (LayerStack:WriteDcl dclfname)) ) (princ "\nThe dialog file could not be written.") ) ( (<= (setq dclid (load_dialog dclfname)) 0) (princ "\nThe dialog file could not be loaded.") ) ( (not (new_dialog "layerstack" dclid)) (princ "\nThe dialog could not be displayed.") ) ( t (LayerStack:ArrowTiles) (set_tile "dcltitle" dcltitle) ;; Collect the layers, excluding xref-dependent ones - a "|" in the ;; name marks those, and their draw order belongs to the source. (while (setq x (tblnext "LAYER" (null x))) (if (not (wcmatch (cdr (assoc 2 x)) "*|*")) (setq layers (cons (cdr (assoc 2 x)) layers)) ) ) (setq layers (acad_strlsort layers)) (LayerStack:MakeList "layer1" (setq layer1 layers)) ;; The current layer is preselected, since it is very often the one ;; the user came here to reorder. (set_tile "layer1" (setq value1 (itoa (vl-position (getvar 'CLAYER) layer1)))) (action_tile "layer1" "(setq value1 $value)") (action_tile "layer2" "(setq value2 $value)") (set_tile "filter" "*") (action_tile "help" "(LayerStack:Help dclid hlptitle)") ;; Add: move the selection from the left pane to the right. (action_tile "add" (vl-prin1-to-string '( (lambda ( / index items ) (cond ( value1 (setq index (LayerStack:ToIndices value1) items (mapcar (function (lambda ( n ) (nth n layer1))) index) ) (LayerStack:MakeList "layer2" (setq layer2 (append layer2 items))) (set_tile "layer2" (setq value2 (cond (value2) ("0")))) (LayerStack:MakeList "layer1" (setq layer1 (LayerStack:RemoveItems index layer1))) (if layer1 (set_tile "layer1" (setq value1 "0")) (setq value1 nil) ) ) ) ) ) ) ) ;; Remove: move back, restoring alphabetical order on the left. (action_tile "del" (vl-prin1-to-string '( (lambda ( / index items ) (cond ( value2 (setq index (LayerStack:ToIndices value2) items (mapcar (function (lambda ( n ) (nth n layer2))) index) ) (LayerStack:MakeList "layer1" (setq layer1 (acad_strlsort (append layer1 items)))) (set_tile "layer1" (setq value1 (cond (value1) ("0")))) (LayerStack:MakeList "layer2" (setq layer2 (LayerStack:RemoveItems index layer2))) (if layer2 (set_tile "layer2" (setq value2 "0")) (setq value2 nil) ) ) ) ) ) ) ) ;; Filter the left pane. An empty filter rebuilds the full list, ;; minus anything already chosen or covered by a chosen pattern. (action_tile "filter" (vl-prin1-to-string '(if (= 1 $reason) (cond ( (= "" (setq pattn (strcase $value))) (set_tile "filter" "*") (LayerStack:MakeList "layer1" (setq layer1 (vl-remove-if (function (lambda ( x ) (or (vl-position x layer2) (vl-some (function (lambda ( p ) (wcmatch (strcase x) p))) layer2) ) ) ) layers ) ) ) (if layer1 (set_tile "layer1" (setq value1 "0")) (setq value1 nil) ) ) ( t (LayerStack:MakeList "layer1" (setq layer1 (vl-remove-if-not (function (lambda ( x ) (wcmatch (strcase x) pattn))) layer1)) ) (if layer1 (set_tile "layer1" (setq value1 "0")) (setq value1 nil) ) ) ) ) ) ) ;; Add a wildcard pattern as a single ordering entry. Every layer it ;; matches is removed from both panes, since the pattern now stands ;; for all of them. A pattern matching nothing is refused rather ;; than silently added. (action_tile "pattern" (vl-prin1-to-string '(if (= 1 $reason) (cond ( (= "" (setq pattn (strcase $value)))) ( (= (length (append layer1 layer2)) (+ (length (setq filt1 (vl-remove-if (function (lambda ( x ) (wcmatch (strcase x) pattn))) layer1))) (length (setq filt2 (vl-remove-if (function (lambda ( x ) (wcmatch (strcase x) pattn))) layer2))) ) ) (alert "No layers match that pattern.") (mode_tile "pattern" 2) ) ( t (LayerStack:MakeList "layer2" (setq layer2 (append filt2 (list pattn)))) (set_tile "layer2" (setq value2 (itoa (1- (length layer2))))) (LayerStack:MakeList "layer1" (setq layer1 filt1)) (set_tile "layer1" (setq value1 "0")) (set_tile "pattern" "") ) ) ) ) ) ;; The four reordering arrows share one action shape: call the ;; relevant move function, rebuild the list, and restore the ;; selection to where the items ended up. (mapcar (function (lambda ( key fun ) (action_tile key (strcat "(" " (lambda ( x )" " (LayerStack:MakeList \"layer2\" (setq layer2 (cadr x)))" " (set_tile \"layer2\" (setq value2 (LayerStack:ToValue (car x))))" " )" " (" fun " (LayerStack:ToIndices value2) layer2)" ")" ) ) ) ) '("top" "up" "down" "bottom") '("LayerStack:MoveTop" "LayerStack:MoveUp" "LayerStack:MoveDown" "LayerStack:MoveBottom") ) (action_tile "totop" "(done_dialog 1)") (action_tile "tobottom" "(done_dialog 2)") (if (member (setq dflag (start_dialog)) '(1 2)) (if layer2 (progn ;; AutoCAD 2015 and later refuse (command) inside an *error* handler ;; unless the routine says up front that it will use one. Restore does, ;; to close this undo group. The declaring call is absent on older ;; releases, so it is wrapped rather than tested for. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (LayerStack:Apply (LayerStack:Doc) layer2 (= 1 dflag)) (vla-regen (LayerStack:Doc) acactiveviewport) (princ (strcat "\nDraw order adjusted for " (itoa (length layer2)) " layer" (if (= 1 (length layer2)) "" "s") " - moved to the " (if (= 1 dflag) "top." "bottom.") ) ) ) (princ "\nNo layers were chosen - nothing to reorder.") ) (princ "\n*Cancelled*") ) ) ) (LayerStack:Restore) (princ) ) (princ)