Lee Mac lisp modification - Keep blocks on original layer

[Organic]

Hi Lee & others,

 

With regards to Lee Mac's code from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-to-0-layer-by-layer-including-block-and-block-in/td-p/5376995

 

(defun c:blkto0 ( / idx lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
)
)
(command "_.regen")
(princ)
)
(defun block->0 ( blk / ent enx )
(cond
( (member blk lst))
( (setq ent (tblobjname "block" blk))
(while (setq ent (entnext ent))
(entmod (subst-append 8 "0" (subst-append 62 0 (setq enx (entget ent)))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(block->0 (cdr (assoc 2 enx)))
)
)
(setq lst (cons blk lst))
)
)
)
(defun subst-append ( key val lst / itm )
(if (setq itm (assoc key lst))
(subst (cons key val) itm lst)
(append lst (list (cons key val)))
)
)

 

The above works excellent when drawings are set up well although unfortunately a lot of architectural ones are not...

 

Is it possible to modify this so it changes all blocks/nested blocks to have colour set to 'by block' as per the above although so that the blocks/nested blocks all keep their original layers (i.e. not go to layer 0 etc)?

 

Thanks

Edited May 30, 2017 by Organic

[Organic]

I worked it out

 

Removing the layer change part (subst-append 8 "0" and its close bracket done it!

 

(defun c:blkto0 ( / idx lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
)
)
(command "_.regen")
(princ)
)
(defun block->0 ( blk / ent enx )
(cond
( (member blk lst))
( (setq ent (tblobjname "block" blk))
(while (setq ent (entnext ent))
(entmod (subst-append 62 0 (setq enx (entget ent))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(block->0 (cdr (assoc 2 enx)))
)
)
(setq lst (cons blk lst))
)
)
)
(defun subst-append ( key val lst / itm )

 

Thanks for the excellent lisp.

[Lee Mac]

Your modification is correct - well done.

 

Here is the code with appropriate indentation:

(defun c:blkto0 ( / idx lst sel )
   (if (setq sel (ssget '((0 . "INSERT"))))
       (repeat (setq idx (sslength sel))
           (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
       )
   )
   (command "_.regen")
   (princ)
)
(defun block->0 ( blk / ent enx )
   (cond
       (   (member blk lst))
       (   (setq ent (tblobjname "block" blk))
           (while (setq ent (entnext ent))
               (entmod (subst-append 62 0 (setq enx (entget ent))))
               (if (= "INSERT" (cdr (assoc 0 enx)))
                   (block->0 (cdr (assoc 2 enx)))
               )
           )
           (setq lst (cons blk lst))
       )
   )
)
(defun subst-append ( key val lst / itm )
   (if (setq itm (assoc key lst))
       (subst (cons key val) itm lst)
       (append lst (list (cons key val)))
   )
)

 

I'm pleased that you find the program useful!