Move blocks to layer

[Anonymous]

Been looking through the forum for this, but most everything that I find tends to related to moving the layers WITHIN the block to a certain layer.

I'm looking for a lisp routine that will let me select a block (model or paper space), prompt me with a dialog box of layers (similar to the Merge to Layer dialog box; right click on layer in Layer Prop Manager, select "Merge selected layer to ..."), and copy all instances of that block to the layer I select.

[SeeMSixty7]

You could just use QuickSelect and select all blocks with the blockname specified, then simply select the new layer in the properties layer pull down.

[Anonymous]

this only works for something in the current space I'm looking at (model or whichever layout tab)... I'm hoping for something that works throughout the entire drawing file.

Specific example of what I'm working with - I've got 10 or so sheets in one drawing file and my matchlines somehow all got put on different layers.  I am hoping for something that will let me select the matchline block in any one of the layout tabs, and change all of the matchline blocks on all of the sheets, at once.

[SeeMSixty7]

Rather than create a dialog interface, you could simply set your current layer to the desired layer for the blocks and then use something like this.

(defun c:qlaychg()
	(setq blkent (entsel "\nSelect Block to move to current layer: "))
	(if blkent
		(progn
			(setq blkname (cdr (assoc 2 (entget (car blkent))))
			      blkss (ssget "X" (list (cons 0 "INSERT") (cons 2 blkname)))
			      blksslen (sslength blkss)
			      blkcnt 0
			)
			(while (< blkcnt blksslen)
			   (setq ent (ssname blkss blkcnt)
			         data (entget ent)
			         old (assoc 8 data)
			         new (cons 8 (getvar "clayer"))
			         blkcnt (1+ blkcnt)
			         data (subst new old data)
			   )
			   (entmod data)
			)
	    )
	 )
)

[pendean]

There are many posted LISP solutions to move content inside of blocks to a specific layer, have you tried a search here or on the web?

[Anonymous]

@pendean- Not looking to change the internal layering of the block... I'm looking to change the layer that all the blocks are inserted on.

@SeeMSixty7  - Tried your lisp routine, but I got an error:  

error: bad argument type: lselsetp nil

[Kent1Cooper]

---

@Anonymous wrote:

....

@SeeMSixty7  - Tried your lisp routine, but I got an error:  

error: bad argument type: lselsetp nil

---

Is it a dynamic Block?  Then you need to get its "effective name" rather than just what's in the (assoc 2) entry in entity data -- (ssget) can't find them by that.  If it is, write back....

[Anonymous]

One block is dynamic, yes...  I tried it on other blocks and it worked fine.

How do I get it's "effective name"?  Or can it be written in a manner where that doesn't matter?

[SeeMSixty7]

Dynamic Blocks make things so much more fun.

At that point you turn it into the initial selected entity into a VL Object get the Effective Name of the block. Then run through the entire dwgs selection set of inserts and then step into each one and if it matched the effective name then change the layer. Joy. If someone doesn't write it shortly. I'll update the routine later for you.

Good luck

[dlanorh · Accepted solution]

Try this

(defun c:cbl ( / ent bname ss cnt obj)
  (setq ent (car (entsel "\nSelect Typical Block to Change Layer : ")))
  (cond (ent
          (setq obj (vlax-ename->vla-object ent)
                bname (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name))
                ss (ssget "X" '((0 . "INSERT")))
          )
          (cond (ss
                  (repeat (setq cnt (sslength ss))
                    (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
                    (if (= (strcase bname) (strcase (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name))))
                      (vlax-put-property obj 'layer (getvar 'clayer))
                    );end_if
                  );end_repeat
                )
          );end_cond
        )
  );end_cond
  (princ)
);end_defun

[Kent1Cooper · Accepted solution]

Something like this, perhaps? [untested] :

(defun C:BMSCL (/ bsel blk bdata blkname bss n bobj)
  ; = Block(s) Matching Selected one to Current Layer [set that first]
  (if
    (and
      (setq bsel (entsel "\nSelect Block to move all like it to current layer: "))
      (setq bdata (entget (setq blk (car bsel))))
      (member '(0 . "INSERT") bdata); it's an Insert object, but:
      (= (logand (cdr (assoc 70 bdata)) 4) 0); not an Xref
    ); and
    (progn ; then
      (setq blkname (vlax-get-property (vlax-ename->vla-object blk) 'EffectiveName))
      (if (setq bss (ssget "_X" '((0 . "INSERT")))); all in drawing [not by name]
        (repeat (setq n (sslength bss))
          (setq bobj (vlax-ename->vla-object (ssname bss (setq n (1- n)))))
          (if (= (vlax-get-property bobj 'EffectiveName) blkname)
            (vla-put-Layer bobj (getvar 'clayer))
          ); if
        ); repeat
      ); if
    ); progn
  ); if
  (princ)
); defun

The 'EffectiveName property works for both ordinary and dynamic Blocks [in new-enough versions -- if you have an old-enough version that it's not available, you don't have dynamic Blocks anyway.]  There's also a plain 'Name property that will be different from the 'EffectiveName for a dynamic Block, but the same for an ordinary one.  That will be different for each Insertion of the same dynamic Block, and since it's what's in the (assoc 2) entry in entity data, that's why (ssget) can't find them collectively.

[Anonymous]

@Kent1Cooper @dlanorh  - Both setups worked as intended.  Thank you both for working this up, and both have been marked as a solution.

As with everything in AutoCAD, there's 50 different ways to get the same line/lisp drawn 🙂

[Jonathan3891]

Looks like I'm a little late, but here's my go at it.

My version lets you select your layer from a dialog box similar to your original post.

(defun sel-dial ()
(setq fname (strcat (getvar "dwgprefix") "liso.dcl")) 
(setq fn (open fname "w"))
(write-line 
"sel_layer : dialog {" fn)
(write-line (strcat "label = " "\"" "CHANGE BLOCK TO LAYER" "\"" ";") fn)
(write-line  "spacer_1;" fn)
(write-line  ":list_box {" fn)
(write-line (strcat "key = " "\""  "alist" "\"" ";") fn)
(write-line (strcat "label = " "\""  "Target Layer:" "\"" ";") fn)
(write-line "width=32;" fn)
(write-line "height=24;" fn)  
(write-line "allow_accept=true;" fn)
(write-line "multiple_select=true;}" fn)
(write-line "spacer_0;" fn)
(write-line "spacer_0;" fn)
(write-line "ok_cancel;}" fn)
(close fn)
)

;;;(tablelist) from Afralisp.com
;(written by Michael Puckett)

(defun tablelist (s / d r)
	(while 
		(setq d (tblnext s (null d)))
		(setq r (cons (cdr (assoc 2 d)) r))
	);while
);defun

(defun C:CB2L (/ all_layers result dcl_ex dcl_id fname laysel lay_list)
(setq ucmdecho (getvar 'cmdecho))
(setvar "cmdecho" 0)
(setq uexpert (getvar 'expert))
(setvar "expert" 2)
(sel-dial)
(setq dcl_id (load_dialog fname))
(new_dialog "sel_layer" dcl_id)    

      (setq all_layers (reverse (tablelist "layer")))
      (start_list "alist")
      (mapcar 'add_list all_layers)
      (end_list)
      (action_tile "alist" "(setq result $value)")
      (start_dialog)
      (unload_dialog dcl_id)
      (done_dialog)
      (vl-file-delete fname)

(if result
(progn
      (setq ss (ssget '((0 . "INSERT"))))
      (setq laysel (nth (atoi result) all_layers))
      (command "_.change" ss "" "P" "LA" laysel "")
  )
  (princ "\nNo layer selected!")
  )
(setvar 'cmdecho ucmdecho)
(setvar 'expert uexpert)
(princ)
)

[Anonymous]

@Jonathan3891  - Thanks for this submission, it's almost exactly what I was hoping for.

When I tried your routine, it only changed the objects in the layout that I was currently in, rather than all the layouts.  Can you update to include this?

That aside, I really like how I can select multiple blocks.

[Jonathan3891 · Accepted solution]

@Anonymous  I updated the code to include all blocks like you asked.

I used some of @dlanorh code posted above to make it work which I've credited him for.

(defun sel-dial ()
(setq fname (strcat (getvar "dwgprefix") "liso.dcl")) 
(setq fn (open fname "w"))
(write-line 
"sel_layer : dialog {" fn)
(write-line (strcat "label = " "\"" "CHANGE BLOCKS TO LAYER" "\"" ";") fn)
(write-line  "spacer_1;" fn)
(write-line  ":list_box {" fn)
(write-line (strcat "key = " "\""  "alist" "\"" ";") fn)
(write-line (strcat "label = " "\""  "Target Layer:" "\"" ";") fn)
(write-line "width=32;" fn)
(write-line "height=24;" fn)  
(write-line "allow_accept=true;" fn)
(write-line "multiple_select=true;}" fn)
(write-line "spacer_0;" fn)
(write-line "spacer_0;" fn)
(write-line "ok_cancel;}" fn)
(close fn)
)

;;;(tablelist) from Afralisp.com
;(written by Michael Puckett)

(defun tablelist (s / d r)
	(while 
		(setq d (tblnext s (null d)))
		(setq r (cons (cdr (assoc 2 d)) r))
	);while
);defun

(defun C:CB2L (/ all_layers result dcl_ex dcl_id fname laysel lay_list ent bname ss cnt obj)
(setq ucmdecho (getvar 'cmdecho))
(setvar "cmdecho" 0)
(setq uexpert (getvar 'expert))
(setvar "expert" 2)
(sel-dial)
(setq dcl_id (load_dialog fname))
(new_dialog "sel_layer" dcl_id)    

      (setq all_layers (reverse (tablelist "layer")))
      (start_list "alist")
      (mapcar 'add_list all_layers)
      (end_list)
      (action_tile "alist" "(setq result $value)")
      (start_dialog)
      (unload_dialog dcl_id)
      (done_dialog)
      (vl-file-delete fname)

(if result
(progn
      (setq laysel (nth (atoi result) all_layers))
  ;;Written by dlanorh-----
      (setq ent (car (entsel "\nSelect Block : ")))
  (cond (ent
          (setq obj (vlax-ename->vla-object ent)
                bname (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name))
                ss (ssget "X" '((0 . "INSERT")))
          )
          (cond (ss
                  (repeat (setq cnt (sslength ss))
                    (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
                    (if (= (strcase bname) (strcase (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name))))
                      (vlax-put-property obj 'layer laysel)
                    );end_if
                  );end_repeat
                )
          );end_cond
        )
  );end_cond
  ;;;----------------------
  )
  (princ "\nNo layer selected!")
  )
(setvar 'cmdecho ucmdecho)
(setvar 'expert uexpert)
(princ)
)

[Anonymous]

@Jonathan3891 

Excellent!!  works perfectly 🙂  marked as a solution and I'll give it two thumbs up for hitting all my wants 🙂