Topic: Block sub entities to insert's layer.

[The Unidrafter]

Hi. I'm a new member. Can't believe I haven't run across this site a lot earlier, since I've been researching online for Autolisp help for nearly 20 years now. So, here is my task: I receive files from architects that I have to format as backgrounds for my firm's HVAC, Plumbing & FP drawings. The problem is that a lot of architects put blocks of things like windows, doors, cabinets, etc.  in their drawings on various layers, formatted so that the linetype name assigned to the individual blocks (and sub-entities) is "demolished", resulting in the blocks showing the demolished linetype and the color of the layer they're inserted on. I need to transfer all blocks which have the "demolished" linetype to the layer "A-DEMO" with each block's sub-entities also set to the "A-DEMO" layer (just in case somebody explodes one or more) with the linetype set to ByLayer for the same reason. I have everything solved except for iterating through the blocks and setting all the sub-entities' layer and linetype. I've written the following code to get the job done, but can't seem to get it correct. While I'm sure it's not the only problem, I keep getting the "Too many arguments" error when I try to run it. Anybody have a clue?

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun c:BO2L (/        inserts_set     inserts_count   insert_name     insert_data
3.                         entity_set      entity_count    entity_name     entity_data entity_layer
4.               )
5.    (if (setq inserts_set (ssget "_x" '((0 . "INSERT")(8 . "A-DEMO"))))                  ; Parent IF- get set of blocks, if any exist
6.         (progn                                                                                          ; then
7.            (setq inserts_count (sslength inserts_set))                                  ;set up block counter
8.            (while (>= (setq inserts_count (1- inserts_count)) 0)                        ;step through block set
9.               (setq insert_name (ssname inserts_set  inserts_count)                     ;select block by index
10.                  insert_data (entget insert_name)                                               ;get data of block
11.                  insert_layer (cdr (assoc 8 insert_data))                                       ;extract layer from data
12.               )                                                                                                 ;end of block layer extraction
13.               (if (setq entity_set (ssget insert_data '(entget insert_name)))           ;child IF- get set of block's sub-entities
14.                  (progn                                                                 ;then
15.                     (setq entity_count (sslength entity_set))                           ;set up entity counter
16.                     (while (>= (setq entity_count (1- entity_count)) 0)                 ;step through entity set
17.                         (setq entity_name (ssname entity_set entity_count)              ;select entity by index
18.                            entity_data (entget entity_name)                             ;get data of sub-entity
19.                            entity_layer (assoc 8 entity_data))                          ;extract sub-entity's layer from data
20.                         (setq entity_name1 (subst insert_layer entity_layer entity_data));substitute block layer for entity layer
21.                         (entmod entity_name1)                                           ;update the drawing database
22.                         (entupd entity_name1)                                           ;update the graphics
23.                      )                                                                  ;end while condition for entity counter
24.                  )                                                                      ;end entity progression for positive condition
25.              )                                                                          ;end child IF for entities (no negative provisions)
26.          )                                                                              ;end while condition for block counter
27.       )                                                                                 ;end block progression for positive condition
28.    )                                                                                    ;end parent IF for blocks(no negative provisions)
29. )
30.  

[tombu]

I'd recommend setting all the properties of the block entities to ByBlock on layer 0 so the blocks colors, linetypes, etc would be the same as the  layer "A-DEMO" once they're placed there. No need to have different blocks for existing, demo and design that way.
https://www.cad-notes.com/layer-0-bylayer-and-byblock/

Lots of lisp out there for setting all block entities to ByBlock on layer 0 already.

Here's one I use:

Code: [Select]

; Written By: Peter Jamtgaard 12/20/2006
;^P(or C:BlkByBlock (load "BlkByBlock.lsp"));BlkByBlock
(defun C:BlkByBlock (/ colBlockReference
                    ActDoc dprSelection
                    objSelection strBlockName
                 )
 (if (setq dprSelection (entsel "\nSelect Block: "))
  (progn
   (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
         dprSelection (car dprSelection)
         objSelection (vlax-ename->vla-object dprSelection)
   )
   (vla-StartUndoMark ActDoc)
   (BlkByBlock objSelection)
   (entupd dprSelection)
   (vla-EndUndoMark ActDoc)
  )
 )
 (prin1)
)

(defun BlkByBlock (objSelection / colBlockReference objBlock
                    strBlockName
                 )
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection)))
 (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
  (progn
   (vlax-for objBlock (vla-item
                       (vla-get-blocks ActDoc)
                       (vla-get-name objSelection)
                      )

    (vla-put-Color objBlock 0)
    (vla-put-Layer objBlock "0")
    (vla-put-linetype objBlock "ByBlock")
    (vla-put-Lineweight objBlock -1)
    (vla-put-PlotStyleName objBlock "ByBlock")
   )
  )
 )
 (prin1)
)
(prin1)

[The Unidrafter]

I've seen several examples of lisp for zero and by layer. The problem is "Operator Headspace". I have an engineer or two (including a micro-managing  owner) who inadvertently explodes blocks, erasing all the demolition linework. This routine is intended to be "insurance" against this happening. We have separate plans for new work anyway.

[JohnK]

You are getting that error because of line 13 in your routine (your SSGET syntax is wrong).

[Tharwat]

Hi,
Try the following quickly written codes and be sure to have your layers unlocked in prior of running the codes.

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test ( / int sel doc ent blk bkn lst get )
2.   ;; Tharwat - 19.Nov.2021      ;;
3.   (and (setq int -1 sel (ssget "_X" '((0 . "INSERT") (8 . "A-DEMO"))))
4.        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
5.        (or (vla-startUndoMark doc) t)
6.        (while (setq int (1+ int) ent (ssname sel int))
7.          (or (member (setq bkn (cdr (assoc 2 (entget ent)))) lst)
8.              (and (setq lst (cons bkn lst)
9.                         blk (tblobjname "BLOCK" bkn))
10.                   (while (setq blk (entnext blk))
11.                     (entmod (subst '(8 . "A-DEMO") (assoc 8 (setq get (entget blk))) get))
12.                     )
13.                   )
14.              )
15.          )
16.        (or (vla-EndUndomark doc) t)
17.        (vla-regen doc AcAllViewports)
18.        )
19.   (princ)
20.   ) (vl-load-com)

[The Unidrafter]

Thanks. I'll be sure to check it out in the morning. Every little bit helps me to educate myself.
**EDIT** Worked like a charm, and showed me a few things about accessing/ modifying sub-entities, as well as using ActiveX. Thanks!

[JohnK]

You can quickly check if the layer A-DEMO" is locked with something like:

Code - Auto/Visual Lisp: [Select]

1. ;; 4  = Layer is locked
2. (logand 4 (cdr (assoc 70 (entget (tblobjname "layer" "A-DEMO")))))