Jump to content

Explode but keep colours.


Manila Wolf

Recommended Posts

A very hopeful question because my lisp skills are very limited indeed.

 

Anybody have a lisp in their library that could do the following: -

 

Allow selection of a block or a selection of a number of objects that may contain blocks and fully explode it (including the exploding of all levels of nested blocks within the selection), to layer zero or a specified layer, but keep all the on screen colours of the original block?

 

Why would you want to do that I hear you say?

 

I like to paste detailed parts of drawings into another drawing maintaining all the object colours, but I do not want to clog up the destination drawing with lots of layers.

Link to comment
Share on other sites

Maybe, try this :

 

(defun c:xallblkslay2col (/ ss k e laye collaye sse n ess)
 (vl-load-com)
 (vl-cmdf "_.zoom" "e")
 (vl-cmdf "_.-xref" "u" "*")
 (while (setq ss (ssget "_W"
                        (getvar 'extmin)
                        (getvar 'extmax)
                        '((0 . "INSERT"))
                 )
        )
   (setq k (sslength ss))
   (while (setq e (ssname ss (setq k (1- k))))
     (setq laye (cdr (assoc 8 (entget e))))
     (setq collaye (cdr (assoc 62 (tblsearch "LAYER" laye))))
     (vl-cmdf "_.explode" e)           ; A2009 and higher
                                       ;(vl-cmdf "_.explode" e "") ; A2008 and lower
     (setq sse (ssget "_P"))
     (setq n (sslength sse))
     (while (setq ess (ssname sse (setq n (1- n))))
       (if (/= (cdr (assoc 0 (entget ess))) "INSERT")
         (progn
           (entmod
             (subst (cons 8 "0") (assoc 8 (entget ess)) (entget ess))
           )
           (if (not (assoc 62 (entget ess)))
             (vla-put-color (vlax-ename->vla-object ess) collaye)
           )
           (entupd ess)
         )
       )
     )
   )
 )
 (vl-cmdf "_.-xref" "r" "*")
 (princ)
)
(defun c:xall nil (c:xallblkslay2col))
(prompt "\nShortcut for c:xallblkslay2col is c:xall")
(princ)

 

M.R.

Link to comment
Share on other sites

This should work also - not to influence on XREFs :

 

(defun c:xallblkslay2col (/ loop ss k e laye collaye sse n ess)
 (vl-load-com)
 (setq loop T)
 (while (and loop
             (setq ss (ssget "_X"
                             '((0 . "INSERT"))
                      )
             )
        )
   (repeat (setq k (sslength ss))
     (setq e (ssname ss (setq k (1- k))))
     (if (vlax-property-available-p (vlax-ename->vla-object e) 'Path)
       (ssdel e ss)
     )
   )
   (setq k (sslength ss))
   (if (/= k 0)
     (progn
       (while (setq e (ssname ss (setq k (1- k))))
         (setq laye (cdr (assoc 8 (entget e))))
         (setq collaye (cdr (assoc 62 (tblsearch "LAYER" laye))))
         (vl-cmdf "_.explode" e)       ; A2009 and higher
                                       ;(vl-cmdf "_.explode" e "") ; A2008 and lower
         (setq sse (ssget "_P"))
         (setq n (sslength sse))
         (while (setq ess (ssname sse (setq n (1- n))))
           (if (/= (cdr (assoc 0 (entget ess))) "INSERT")
             (progn
               (entmod
                 (subst (cons 8 "0")
                        (assoc 8 (entget ess))
                        (entget ess)
                 )
               )
               (if (not (assoc 62 (entget ess)))
                 (vla-put-color (vlax-ename->vla-object ess) collaye)
               )
               (entupd ess)
             )
           )
         )
       )
     )
     (setq loop nil)
   )
 )
 (princ)
)
(defun c:xall nil (c:xallblkslay2col))
(prompt "\nShortcut for c:xallblkslay2col is c:xall")
(princ)

 

M.R.

Link to comment
Share on other sites

rkent: - Thank you for your suggestion. I remember looking at Xplode some time ago. Your reply prompted me to take a further look, but I could not arrive at what I am looking for.

 

marko: - Many thanks for your prompt replies offering coding. I did try both codes, but unfortunately the codes only work in some instances.

 

I attach a simple drawing that I created to act as a test.

When I ran the code, the series of lines were indeed all sent to layer zero, but some colours did also change to the layer zero colour which in this test case is white.

 

I think a lot is dependent on what layer the original objects were created on in the first place before being nested into blocks.

In my test drawing, with the series of lines on the left, each line was drawn on a separate individual layer, with colour bylayer before being nested into a block.

With the series of lines on the right of the drawing, each line was drawn on layer zero with the colour of each being changed but still on layer zero, all before being nested into a block.

Xall-Test1.dwg

Link to comment
Share on other sites

Thank you for your testing, I think that now it will work...

 

([color=BLUE]defun[/color] [color=BLUE]c:xallblkslay2col[/color] ([color=BLUE]/[/color] loop ss k e laye layess collaye collayess sse n ess)
 ([color=BLUE]vl-load-com[/color])
 ([color=BLUE]setq[/color] loop [color=BLUE]T[/color])
 ([color=BLUE]while[/color] ([color=BLUE]and[/color] loop
             ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] [color=BROWN]"_X"[/color]
                             '((0 . [color=BROWN]"INSERT"[/color]))
                      )
             )
        )
   ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] k ([color=BLUE]sslength[/color] ss))
     ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] k ([color=BLUE]1-[/color] k))))
     ([color=BLUE]if[/color] ([color=BLUE]vlax-property-available-p[/color] ([color=BLUE]vlax-ename->vla-object[/color] e) 'Path)
       ([color=BLUE]ssdel[/color] e ss)
     )
   )
   ([color=BLUE]setq[/color] k ([color=BLUE]sslength[/color] ss))
   ([color=BLUE]if[/color] ([color=BLUE]/=[/color] k 0)
     ([color=BLUE]progn[/color]
       ([color=BLUE]while[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] k ([color=BLUE]1-[/color] k))))
         ([color=BLUE]setq[/color] laye ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] e))))
         ([color=BLUE]setq[/color] collaye ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]tblsearch[/color] [color=BROWN]"LAYER"[/color] laye))))
         ([color=BLUE]vl-cmdf[/color] [color=BROWN]"_.explode"[/color] e)       ; A2009 and higher
                                       ;(vl-cmdf "_.explode" e "") ; A2008 and lower
         ([color=BLUE]setq[/color] sse ([color=BLUE]ssget[/color] [color=BROWN]"_P"[/color]))
         ([color=BLUE]setq[/color] n ([color=BLUE]sslength[/color] sse))
         ([color=BLUE]while[/color] ([color=BLUE]setq[/color] ess ([color=BLUE]ssname[/color] sse ([color=BLUE]setq[/color] n ([color=BLUE]1-[/color] n))))
           ([color=BLUE]if[/color] ([color=BLUE]/=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ess))) [color=BROWN]"INSERT"[/color])
             ([color=BLUE]progn[/color]
               ([color=BLUE]setq[/color] layess ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))))
               ([color=BLUE]setq[/color] collayess ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]tblsearch[/color] [color=BROWN]"LAYER"[/color] layess))))
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]/=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))) [color=BROWN]"0"[/color]) ([color=BLUE]not[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]entget[/color] ess))))
                 ([color=BLUE]vla-put-color[/color] ([color=BLUE]vlax-ename->vla-object[/color] ess) collayess)
               )
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))) [color=BROWN]"0"[/color]) ([color=BLUE]not[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]entget[/color] ess))))
                 ([color=BLUE]vla-put-color[/color] ([color=BLUE]vlax-ename->vla-object[/color] ess) collaye)
               )
               ([color=BLUE]entmod[/color]
                 ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 8 [color=BROWN]"0"[/color])
                        ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))
                        ([color=BLUE]entget[/color] ess)
                 )
               )
               ([color=BLUE]entupd[/color] ess)
             )
           )
         )
       )
     )
     ([color=BLUE]setq[/color] loop [color=BLUE]nil[/color])
   )
 )
 ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] [color=BLUE]c:xall[/color] [color=BLUE]nil[/color] ([color=BLUE]c:xallblkslay2col[/color]))
([color=BLUE]prompt[/color] [color=BROWN]"\nShortcut for c:xallblkslay2col is c:xall"[/color])
([color=BLUE]princ[/color])

 

M.R.

Link to comment
Share on other sites

Marko, This works very well indeed. You made my day!

 

I tested it not just on my own simple test drawing, but on other more detailed drawings. It worked in every scenario.

 

I shall now be using this code extensively, so sincere thanks for your impressive coding skills and for your valuable time spent helping me.

 

Cheers. :beer:

Link to comment
Share on other sites

  • 6 years later...
On 9/10/2012 at 1:09 PM, marko_ribar said:

Thank you for your testing, I think that now it will work...

 

 


([color=BLUE]defun[/color] [color=BLUE]c:xallblkslay2col[/color] ([color=BLUE]/[/color] loop ss k e laye layess collaye collayess sse n ess)
 ([color=BLUE]vl-load-com[/color])
 ([color=BLUE]setq[/color] loop [color=BLUE]T[/color])
 ([color=BLUE]while[/color] ([color=BLUE]and[/color] loop
             ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] [color=BROWN]"_X"[/color]
                             '((0 . [color=BROWN]"INSERT"[/color]))
                      )
             )
        )
   ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] k ([color=BLUE]sslength[/color] ss))
     ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] k ([color=BLUE]1-[/color] k))))
     ([color=BLUE]if[/color] ([color=BLUE]vlax-property-available-p[/color] ([color=BLUE]vlax-ename->vla-object[/color] e) 'Path)
       ([color=BLUE]ssdel[/color] e ss)
     )
   )
   ([color=BLUE]setq[/color] k ([color=BLUE]sslength[/color] ss))
   ([color=BLUE]if[/color] ([color=BLUE]/=[/color] k 0)
     ([color=BLUE]progn[/color]
       ([color=BLUE]while[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] k ([color=BLUE]1-[/color] k))))
         ([color=BLUE]setq[/color] laye ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] e))))
         ([color=BLUE]setq[/color] collaye ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]tblsearch[/color] [color=BROWN]"LAYER"[/color] laye))))
         ([color=BLUE]vl-cmdf[/color] [color=BROWN]"_.explode"[/color] e)       ; A2009 and higher
                                       ;(vl-cmdf "_.explode" e "") ; A2008 and lower
         ([color=BLUE]setq[/color] sse ([color=BLUE]ssget[/color] [color=BROWN]"_P"[/color]))
         ([color=BLUE]setq[/color] n ([color=BLUE]sslength[/color] sse))
         ([color=BLUE]while[/color] ([color=BLUE]setq[/color] ess ([color=BLUE]ssname[/color] sse ([color=BLUE]setq[/color] n ([color=BLUE]1-[/color] n))))
           ([color=BLUE]if[/color] ([color=BLUE]/=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ess))) [color=BROWN]"INSERT"[/color])
             ([color=BLUE]progn[/color]
               ([color=BLUE]setq[/color] layess ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))))
               ([color=BLUE]setq[/color] collayess ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]tblsearch[/color] [color=BROWN]"LAYER"[/color] layess))))
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]/=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))) [color=BROWN]"0"[/color]) ([color=BLUE]not[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]entget[/color] ess))))
                 ([color=BLUE]vla-put-color[/color] ([color=BLUE]vlax-ename->vla-object[/color] ess) collayess)
               )
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))) [color=BROWN]"0"[/color]) ([color=BLUE]not[/color] ([color=BLUE]assoc[/color] 62 ([color=BLUE]entget[/color] ess))))
                 ([color=BLUE]vla-put-color[/color] ([color=BLUE]vlax-ename->vla-object[/color] ess) collaye)
               )
               ([color=BLUE]entmod[/color]
                 ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 8 [color=BROWN]"0"[/color])
                        ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ess))
                        ([color=BLUE]entget[/color] ess)
                 )
               )
               ([color=BLUE]entupd[/color] ess)
             )
           )
         )
       )
     )
     ([color=BLUE]setq[/color] loop [color=BLUE]nil[/color])
   )
 )
 ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] [color=BLUE]c:xall[/color] [color=BLUE]nil[/color] ([color=BLUE]c:xallblkslay2col[/color]))
([color=BLUE]prompt[/color] [color=BROWN]"\nShortcut for c:xallblkslay2col is c:xall"[/color])
([color=BLUE]princ[/color])
Sorry I'm new to lsp.

When I loaded your code to AutoCAD 2019 I got an error on the command line.
 

Command: APPLOAD
xall.lsp successfully loaded

Command: ; error: extra cdrs in dotted pair on input

 

M.R.

 

Edited by NRZ
NVM. Thank you btw
Link to comment
Share on other sites

Maybe it has something to do with the revised forum code formatting.

I attach the original lisp written by Marko that I got from the old Cadtutor forum.

I still use it often, now on AutoCAD 2016. (Thanks again Marko).

I added the top two lines but I think the link to the original Cadtutor thread is now defunct.

 

;By Cadtutor poster marko_ribar
;http://www.cadtutor.net/forum/showthread.php?72503
(defun c:xallblkslay2col (/ loop ss k e laye layess collaye collayess sse n ess)
  (vl-load-com)
  (setq loop T)
  (while (and loop
              (setq ss (ssget "_X"
                              '((0 . "INSERT"))
                       )
              )
         )
    (repeat (setq k (sslength ss))
      (setq e (ssname ss (setq k (1- k))))
      (if (vlax-property-available-p (vlax-ename->vla-object e) 'Path)
        (ssdel e ss)
      )
    )
    (setq k (sslength ss))
    (if (/= k 0)
      (progn
        (while (setq e (ssname ss (setq k (1- k))))
          (setq laye (cdr (assoc 8 (entget e))))
          (setq collaye (cdr (assoc 62 (tblsearch "LAYER" laye))))
          (vl-cmdf "_.explode" e)       ; A2009 and higher
                                        ;(vl-cmdf "_.explode" e "") ; A2008 and lower
          (setq sse (ssget "_P"))
          (setq n (sslength sse))
          (while (setq ess (ssname sse (setq n (1- n))))
            (if (/= (cdr (assoc 0 (entget ess))) "INSERT")
              (progn
                (setq layess (cdr (assoc 8 (entget ess))))
                (setq collayess (cdr (assoc 62 (tblsearch "LAYER" layess))))
                (if (and (/= (cdr (assoc 8 (entget ess))) "0") (not (assoc 62 (entget ess))))
                  (vla-put-color (vlax-ename->vla-object ess) collayess)
                )
                (if (and (= (cdr (assoc 8 (entget ess))) "0") (not (assoc 62 (entget ess))))
                  (vla-put-color (vlax-ename->vla-object ess) collaye)
                )
                (entmod
                  (subst (cons 8 "0")
                         (assoc 8 (entget ess))
                         (entget ess)
                  )
                )
                (entupd ess)
              )
            )
          )
        )
      )
      (setq loop nil)
    )
  )
  (princ)
)
(defun c:xall nil (c:xallblkslay2col))
(prompt "\nShortcut for c:xallblkslay2col is c:xall")
(princ)

 

Link to comment
Share on other sites

  • 1 year later...

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