Modify layers within blocks

[dbunch]

We have a requirement by a client to have all draw objects within a block on layer 0. We can set colors & line weights. There are 142 drawings that we have to look through, so automating this task would be quite beneficial. Before I really look into writing something to fix this, thought I would 1st see if anyone has some lisp code to handle this. The way I was going to approach the problem was to create a list of layers with their associated colors & line weights. Create a list of the blocks in the drawing using tblnext.
Use the following code for each block in the list.

(setq GBP (entget (tblobjname "BLOCK" BLOCK_NAME))
(SETQ GBPS (cdr (assoc -2 GBP)))
(while GBPS
(setq IE1 (cdr (entget GBPS)))
(setq A (cdr (assoc 8 IE1))) ;Get layer for this object
(if (/= A "0")
(progn
;Hopefully use entmod or another function to change the
;internal block object to layer 0
;Also if the object's color & lineweight are set to by layer,
;Set them according to what they are for that layer.
)
)
)

Does this look possible, or does someone have something to do this already?

Thanks for any help,
David Bunch

Moderator Note:
How to use [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code)

[T.Willey]

If you have a bunch of drawings to go though, I would use ObjectDBX with ActiveX controls. This way you don't have to open the drawings in the editor, so it will be faster. I'm sure there are examples of how to do this on the net, or even this site, but you may have to put a couple together to get your desired results.

[dbunch]

Thanks for the reply. I will take a look around for what you suggested. Meanwhile, below is what I came up while waiting for an answer. Using the entmod does not seem to work, but the rest of the code does. If the objects within the block have color, line type & line weight set to bylayer, entmod will probably not work anyway since those entries do not exist under those conditions. I am thinking I might need to have the program recreate the blocks & then substitute them.

-D.Bunch

;Change the layers within a block to 0
;Set the color & line weight of those objects to what they were for that layer
;BLKLAY.LSP 2/5/2008 By: David Bunch
;
(defun C:BLKLAY (/ A BCOLOR BLLST BLTBL BLTYPE BLWGHT BNAME GBP GBPS I IDX IE
LALST LAYWGT LCLST LCOLR LNAME LNTBL LTLST LTYPE LWLST Q)
(setq LNTBL (tblnext "LAYER" T))
(setq LALST nil) ;Layer Name List
(setq LCLST nil) ;Layer Color List
(setq LTLST nil) ;Layer Line Type List
(setq LWLST nil) ;Layer line Weight List
;Loop through to create list of layers, colors, line types & Line weights
(while LNTBL
(setq LNAME (cdr (assoc 2 LNTBL))) ;Layer Name
(setq LCOLR (itoa (cdr (assoc 62 LNTBL)))) ;Color for this layer
(setq LTYPE (cdr (assoc 6 LNTBL))) ;Line Type for this layer
(setq LAYWGT (cdr (assoc 370 (entget (tblobjname "LAYER" LNAME)))))
(if (= LAYWGT -3)
(progn
(setvar "cmdecho" 0)
(command "-layer" "LWeight" "0.15" LNAME "")
(setvar "cmdecho" 1)
(setq LAYWGT 0.15)
)
)
(setq LALST (append LALST (list LNAME))) ;add Layer Name to list
(setq LCLST (append LCLST (list LCOLR))) ;add Layer Color to list
(setq LTLST (append LTLST (list LTYPE))) ;add Layer Line Type to list
(setq LWLST (append LWLST (list LAYWGT))) ;add Layer Line Weight to list
(setq LNTBL (tblnext "LAYER"))
)
;Create List of Blocks
(setq BLTBL (tblnext "BLOCK" T))
(setq BLLST nil) ;Layer Name List
(while BLTBL
(setq BNAME (cdr (assoc 2 BLTBL))) ;Layer Name
(setq BLLST (append BLLST (list BNAME))) ;add Block Name to list
(setq BLTBL (tblnext "BLOCK"))
)
(princ LALST)(princ "\n\n")
(princ LCLST)(princ "\n\n")
(princ LTLST)(princ "\n\n")
(princ LWLST)(princ "\n\n")
(princ BLLST)
;
;Now comes the fun part
;
(setq IDX 0)
(setq Q (length BLLST))
(while (< IDX Q)
(setq BNAME (nth IDX BLLST))
(setq GBP (entget (tblobjname "BLOCK" BNAME)))
(setq GBPS (cdr (assoc -2 GBP)))
(while GBPS
(setq IE (cdr (entget GBPS)))
(setq A (cdr (assoc 8 IE))) ;Get layer for this object
(setq GBPS (entnext GBPS))
(if (/= A "0")
(progn
(setq I (getblklayer A LALST)) ;Get index of layer in list
(if (/= I -1)
(progn
(princ "\nModifying block ")(princ BNAME)
(setq BCOLOR (nth I LCLST))
(setq BLTYPE (nth I LTLST))
(setq BLWGHT (nth I LWLST))
(setq IE (subst (cons 8 "0") (assoc 8 IE) IE))
(entmod IE) ;execute the modification
)
)
)
)
)
(setq IDX (+ IDX 1))
)
(princ)
)
(defun getblklayer (A LALST / IDX Q RETIDX LN)
(setq IDX 0)
(setq Q (length LALST))
(setq RETIDX -1)
(while (< IDX Q)
(setq LN (nth IDX LALST))
(if (= A LN)
(progn
(setq RETIDX IDX) ;Set Return Index of Layer in list
(setq IDX Q)
)
)
(setq IDX (+ IDX 1))
)
(setq RETIDX RETIDX)
)

[T.Willey]

If they are bylayer, there is not a listing, but if you want to make it something different, then all you need to do is add the listing to the dxf code. I have use append in the past to do this. If you go the ActiveX way I think it is easier.

[dgorsman]

So heres a question - do they mean that when blocks are *created* all objects should be on layer 0 (which is much more common)? Or that all objects inside block references are on layer 0 (first time for everything, I suppose)?

[dbunch]

The client did waive this requirement. Something like this might still be useful when we start having to export Revit files to AutoCAD for Clients.

-D.Bunch

[FRAMEDNLV]

If you search for "nuke" lisp you will find what you want or just go here:

http://discussion.autodesk.com/thread.jspa?messageID=5822819


Simple blocks would be ok to nuke but more complex blocks are better left alone (if proper layer were used).

Chris

['gile']

Hi,

You can try Edit_Bloc