lisp for changing all objects in a block to layer "0"

[chulse]

Does anyone have a lisp that will change all the objects within all the blocks in a given dwg to layer "0" (while maintaing the block on the layer it was inserted into)? I have tried FixBlock, but it seems to only work on 1 t a time.
I have many to do and any help would be much appreciated.

Thanks in advance

[fuccaro]

Just a tip: write a small routine to grab all the blocks defined in the drawing and call FixBlock in a loop, with the blocks -one at a time.

[chulse]

Just a tip: write a small routine to grab all the blocks defined in the drawing and call FixBlock in a loop, with the blocks -one at a time.

That sounds like a great idea, except I have no idea how to do it. Anyone looking for a project?

Thanks for the idea!

[fuccaro]

Can you post the code for the FixBlock lisp?

[chulse]

here ya go.

Need to give credit for it since it's not mine: http://www.cadcorner.ca/lisp.php

Thanks

[fuccaro]

That code is too long for me -it is week end!- so here is my own code.

(defun c:fixblocks( / b1 name ent elist a8 a62)
  (setq b1 (tblnext "BLOCK" t))
  (while b1
    (princ (strcat "\n" (setq name (cdr (assoc 2 b1)))))
    (setq ent (tblobjname "block" name) ent (entnext ent))
    (while ent
      (setq elist (entget ent))
      (setq elist (if (setq a8 (assoc 8 elist)) (subst (cons 8 "0") a8 elist)))
      (setq elist (if (setq a62 (assoc 62 elist)) (subst '(62 . 0) a62 elist)))
      (setq elist (entmod elist))
      (setq ent (entnext ent))
      )
    (setq b1 (tblnext "BLOCK"))
    )
  (princ)
  )

It is not fully tested and it has no error trap. Sorry, it is all I can do at this time.
Do a REGEN after runing the lisp.

****** editing ******* Test it on a drawing with XREFs

[chulse]

Thanks a lot, I'll try it.

[kpblc]

Also try this:

(defun c:norm (/ *error* adoc lst_layer func_restore-layers)
  (defun *error* (msg)
    (func_restore-layers)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun func_restore-layers ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
           ) ;_ end of lambda
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for item (vla-get-layers adoc)
    (setq lst_layer (cons (list item
                                (cons "lock" (vla-get-lock item))
                                (cons "freeze" (vla-get-freeze item))
                                ) ;_ end of list
                          lst_layer
                          ) ;_ end of cons
          ) ;_ end of setq
    (vla-put-lock item :vlax-false)
    (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
    ) ;_ end of vlax-for
  (vlax-for blk (vla-get-blocks adoc)
    (if (and (equal (vla-get-islayout blk) :vlax-false)
             (equal (vla-get-isxref blk) :vlax-false)
             ) ;_ end of and
      (progn
        (vlax-for subent blk
          (vla-put-layer subent "0")
          (vla-put-color subent 0)
          (vla-put-lineweight subent aclnwtbyblock)
          (vla-put-linetype subent "byblock")
          ) ;_ end of vlax-for
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  (func_restore-layers)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[chulse]

Also try this:

That worked!

[Wile E Coyote]

Also try this:

(defun c:norm (/ *error* adoc lst_layer func_restore-layers)
  (defun *error* (msg)
    (func_restore-layers)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
 
  (defun func_restore-layers ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
           ) ;_ end of lambda
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of defun
 
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for item (vla-get-layers adoc)
    (setq lst_layer (cons (list item
                                (cons "lock" (vla-get-lock item))
                                (cons "freeze" (vla-get-freeze item))
                                ) ;_ end of list
                          lst_layer
                          ) ;_ end of cons
          ) ;_ end of setq
    (vla-put-lock item :vlax-false)
    (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
    ) ;_ end of vlax-for
  (vlax-for blk (vla-get-blocks adoc)
    (if (and (equal (vla-get-islayout blk) :vlax-false)
             (equal (vla-get-isxref blk) :vlax-false)
             ) ;_ end of and
      (progn
        (vlax-for subent blk
          (vla-put-layer subent "0")
          (vla-put-color subent 0)
          (vla-put-lineweight subent aclnwtbyblock)
          (vla-put-linetype subent "byblock")
          ) ;_ end of vlax-for
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  (func_restore-layers)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

IMO that is the best thing since flush toilets!
I found this by mistake while looking for something else. The company where I work used to use Medusa (!?) and when all the old files were converted to .dwg files (by an outside company) the "clumps" (groups, dimensions, blocks etc.) in Medusa created an enormous amount of blocks in AutoCAD; a real nightmare to work with.
Norm.lsp has been a revelation so far, but today I ran it on a drawing file and received the error message lisp value has no coercion to VARIANT with this type: -2. Any ideas? A mod to the lisp perhaps?
Many thanks for the original and thanks in advance for any replies.