Manila Wolf Posted September 7, 2012 Share Posted September 7, 2012 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. Quote Link to comment Share on other sites More sharing options...
rkent Posted September 7, 2012 Share Posted September 7, 2012 XPLODE will get you a little closer if not there, watch the command line. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 7, 2012 Share Posted September 7, 2012 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. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 9, 2012 Share Posted September 9, 2012 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. Quote Link to comment Share on other sites More sharing options...
Manila Wolf Posted September 10, 2012 Author Share Posted September 10, 2012 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 Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 10, 2012 Share Posted September 10, 2012 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. Quote Link to comment Share on other sites More sharing options...
Manila Wolf Posted September 10, 2012 Author Share Posted September 10, 2012 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. Quote Link to comment Share on other sites More sharing options...
NRZ Posted May 22, 2019 Share Posted May 22, 2019 (edited) 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 May 22, 2019 by NRZ NVM. Thank you btw Quote Link to comment Share on other sites More sharing options...
Manila Wolf Posted May 23, 2019 Author Share Posted May 23, 2019 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) Quote Link to comment Share on other sites More sharing options...
Cadpoobah Posted March 26, 2021 Share Posted March 26, 2021 Note: the above code will error out when it encounters a non-explodable block. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.