Jump to content

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


chulse

Recommended Posts

Hi this one work so great,,, i like it so much... am seeking for one modification in this...

 

Block entities are perfectly changing to "0" layer, but Block remain in same layer i wanted block also to change in "Desired Layer" or "0" Layer...

And if possible Nested block and Nested Entities to "0" Layer or to "Desired Layer"

 

thanks

 

 

 

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

Link to comment
Share on other sites

  • 4 weeks later...
  • Replies 27
  • Created
  • Last Reply

Top Posters In This Topic

  • kpblc

    6

  • chulse

    5

  • gilsoto13

    4

  • fuccaro

    3

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

 

Does not support Mosaic block?

Drawing155.dwg

version:A2010

Link to comment
Share on other sites

No. I you want to proceed blocks in blocks, try this code:

(defun c:norm2 (/ *error* adoc lst_layer func_restore-layers  fun_get-block-subref-by-block)

 (defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

 (defun fun_get-block-subref-by-block (blk-name)
   (setq res (list blk-name))
   (vlax-for subent (vla-item (vla-get-blocks adoc) blk-name)
     (if (wcmatch (strcase (vla-get-objectname subent)) "*BLOCK*")
       (setq res (append res (fun_get-block-subref-by-block (vla-get-name subent))))
       ) ;_ end of if
     ) ;_ end of vlax-for
   res
   ) ;_ 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 (apply (function append)
                                                (mapcar
                                                  (function
                                                    (lambda (x)
                                                      (fun_get-block-subref-by-block
                                                        (vla-get-name
                                                          (vlax-ename->vla-object x)
                                                          ) ;_ end of vla-get-name
                                                        ) ;_ 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
                                                ) ;_ end of apply
                             (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

Link to comment
Share on other sites

No. I you want to proceed blocks in blocks, try this code:

(defun c:norm2 (/ *error* adoc lst_layer func_restore-layers  fun_get-block-subref-by-block)

 (defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

 (defun fun_get-block-subref-by-block (blk-name)
   (setq res (list blk-name))
   (vlax-for subent (vla-item (vla-get-blocks adoc) blk-name)
     (if (wcmatch (strcase (vla-get-objectname subent)) "*BLOCK*")
       (setq res (append res (fun_get-block-subref-by-block (vla-get-name subent))))
       ) ;_ end of if
     ) ;_ end of vlax-for
   res
   ) ;_ 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 (apply (function append)
                                                (mapcar
                                                  (function
                                                    (lambda (x)
                                                      (fun_get-block-subref-by-block
                                                        (vla-get-name
                                                          (vlax-ename->vla-object x)
                                                          ) ;_ end of vla-get-name
                                                        ) ;_ 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
                                                ) ;_ end of apply
                             (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

 

Thanks kpblc ,very nice! but I find that,color attribute change from bylayer to byblock,

Link to comment
Share on other sites

  • 8 months later...
  • 1 year later...

This thread is a good example of the point I'll make ...

 

 

Is there a way to highlight the post with the best working code?

 

 

I copy/pasted this code, I forgot which version of the code. And I added some code (xref layers were still being processed ...).

It's hard to add code, and let everybody know what I did, because in the mean time other changes have been made.

 

 

I understand this is a forum (it's not Github or so) ... but still

Link to comment
Share on other sites

  • 1 month later...
  • 4 years later...

Someone commented that the lisp that KPBLC created was the best thing since flushing toilets.  I'd go further, I think it's the best thing since sliced bacon, and I really cannot believe that it's taken me so long to find this routine. 

Dealing with dwg exports from Archicad, this will save me a massive amount of time.  Thank you very much indeed ... 😀🍻

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...