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

FixBlock.lsp

[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.

[kpblc]

Attach your file. I think you'd better execute _audit command (with repair any errors) and _purge command.

[gilsoto13]

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

 

 

Hello kpblc. it works amazingly.... but I could make it our standard if it just work for one selected block instead of all the blocks in a drawing. Would that be possible?

[kpblc]

There are some solves: only one selected block, some selected blocks... But I have no enoght time to create fully universal code

(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 vla-put-freeze
          ) ;_ 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
 (if (and (not (vl-catch-all-error-p
                 (setq selset
                        (vl-catch-all-apply
                          (function
                            (lambda ()
                              (ssget '((0 . "INSERT")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
          selset
          ) ;_ end of and
   (progn
     (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 vl-catch-all-apply
       ) ;_ end of vlax-for
     (foreach blk_def
              (mapcar
                (function
                  (lambda (x)
                    (vla-item (vla-get-blocks adoc) x)
                    ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ res)
                   (foreach item (mapcar
                                   (function
                                     (lambda (x)
                                       (vla-get-name
                                         (vlax-ename->vla-object x)
                                         ) ;_ end of vla-get-name
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ((lambda (/ tab item)
                                      (repeat (setq tab  nil
                                                    item (sslength selset)
                                                    ) ;_ end setq
                                        (setq
                                          tab
                                           (cons
                                             (ssname selset
                                                     (setq item (1- item))
                                                     ) ;_ end of ssname
                                             tab
                                             ) ;_ end of cons
                                          ) ;_ end of setq
                                        ) ;_ end of repeat
                                      tab
                                      ) ;_ end of lambda
                                    )
                                   ) ;_ end of mapcar
                     (if (not (member item) res)
                       (setq res (cons item res))
                       ) ;_ end of if
                     ) ;_ end of foreach
                   (reverse res)
                   ) ;_ end of lambda
                 )
                ) ;_ end of mapcar
       (vlax-for ent blk_def
         (vla-put-layer ent "0")
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of foreach
     (func_restore-layers)
     (vla-regen adoc acallviewports)
     ) ;_ end of progn
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[gilsoto13]

Great... Now I can select objects... I used it... but I got this error...

 

Select objects: Specify opposite corner: 2 found

Select objects:

too few arguments

 

And it does nothing with the blocks... but it is the right direction I guess.

 

Yesterday I tested the fixblock.lsp and it works for dynamic and attribute blocks, but it is in normal lisp (not visual lisp) and won´t fix linetype and lineweight.. so yours is better... but definitively would like it for single blocks selection.. (I've got your complete drawing block fixing version already. So the single block fixing would be all we need.

[kpblc]

Ah, that's my mistake... Changed code is:

(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 vla-put-freeze
          ) ;_ 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
 (if (and (not (vl-catch-all-error-p
                 (setq selset
                        (vl-catch-all-apply
                          (function
                            (lambda ()
                              (ssget '((0 . "INSERT")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
          selset
          ) ;_ end of and
   (progn
     (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 vl-catch-all-apply
       ) ;_ end of vlax-for
     (foreach blk_def
              (mapcar
                (function
                  (lambda (x)
                    (vla-item (vla-get-blocks adoc) x)
                    ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ res)
                   (foreach item (mapcar
                                   (function
                                     (lambda (x)
                                       (vla-get-name
                                         (vlax-ename->vla-object x)
                                         ) ;_ end of vla-get-name
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ((lambda (/ tab item)
                                      (repeat (setq tab  nil
                                                    item (sslength selset)
                                                    ) ;_ end setq
                                        (setq
                                          tab
                                           (cons
                                             (ssname selset
                                                     (setq item (1- item))
                                                     ) ;_ end of ssname
                                             tab
                                             ) ;_ end of cons
                                          ) ;_ end of setq
                                        ) ;_ end of repeat
                                      tab
                                      ) ;_ end of lambda
                                    )
                                   ) ;_ end of mapcar
                     (if (not (member item res))
                       (setq res (cons item res))
                       ) ;_ end of if
                     ) ;_ end of foreach
                   (reverse res)
                   ) ;_ end of lambda
                 )
                ) ;_ end of mapcar
       (vlax-for ent blk_def
         (vla-put-layer ent "0")
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of foreach
     (func_restore-layers)
     (vla-regen adoc acallviewports)
     ) ;_ end of progn
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[gilsoto13]

great... now it works!

 

This is the file where I been testing it... It's an Industrial Kitchen and dining building

 

http://www.mediafire.com/?tio4jmxiy2g

 

I will use it to replace all of our block to layer 0 routines... thank you very much!

 

Ah, that's my mistake... Changed code is:

(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 vla-put-freeze
          ) ;_ 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
 (if (and (not (vl-catch-all-error-p
                 (setq selset
                        (vl-catch-all-apply
                          (function
                            (lambda ()
                              (ssget '((0 . "INSERT")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
          selset
          ) ;_ end of and
   (progn
     (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 vl-catch-all-apply
       ) ;_ end of vlax-for
     (foreach blk_def
              (mapcar
                (function
                  (lambda (x)
                    (vla-item (vla-get-blocks adoc) x)
                    ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ res)
                   (foreach item (mapcar
                                   (function
                                     (lambda (x)
                                       (vla-get-name
                                         (vlax-ename->vla-object x)
                                         ) ;_ end of vla-get-name
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ((lambda (/ tab item)
                                      (repeat (setq tab  nil
                                                    item (sslength selset)
                                                    ) ;_ end setq
                                        (setq
                                          tab
                                           (cons
                                             (ssname selset
                                                     (setq item (1- item))
                                                     ) ;_ end of ssname
                                             tab
                                             ) ;_ end of cons
                                          ) ;_ end of setq
                                        ) ;_ end of repeat
                                      tab
                                      ) ;_ end of lambda
                                    )
                                   ) ;_ end of mapcar
                     (if (not (member item res))
                       (setq res (cons item res))
                       ) ;_ end of if
                     ) ;_ end of foreach
                   (reverse res)
                   ) ;_ end of lambda
                 )
                ) ;_ end of mapcar
       (vlax-for ent blk_def
         (vla-put-layer ent "0")
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of foreach
     (func_restore-layers)
     (vla-regen adoc acallviewports)
     ) ;_ end of progn
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[kpblc]

There is one moment... If you'll select dynblock, only selected will be changed (not all dynblocks with the same name). Does it critical? If yes, and if you are using AutoCAD 2006 or later, find in code string vla-get-name and change it to vla-get-effectivename.

[gilsoto13]

i think it won´t be necessary in this case... we usually as any other company, need to fix layers from vendors or other companies to layer 0 and color bylayer to use their without much editing work, most of the companies don´t use dynamic blocks, so we shouldn´t have that problem.

 

We actually use dynamic blocks for many standard blocks, so other companies will struggle with our drawings, thought. but in that case, other drafters will have to find this thread and call your attention again, jejej,....

[VVA]

Another version of the program Alexei (kpblc)

[treaves04]

I know this is an old thread but that is the best thing since sliced bread! Works like a charm.