beltb.lsp multiple blocks

[jtm2020hyo]

I think everyone here knows beltb.lsp. so I will one request to modify him, I need to use belt.lsp in multiple blocks. selecting, naming, and typing "all" or "*" (wildcard).

PD: attached beltb.lsp

[Kent1Cooper]

Now suppose you have a Block A that is nested inside a Block B and also nested inside a Block C [a common occurrence for me -- for example a refrigerator that is used in multiple different apartment plan layouts].  Now suppose you have a Block B inserted on Layer ABC and a Block C inserted on Layer DEF.  If it encounters the Block B insertion first, all parts of that nested Block A's definition would be changed to Layer ABC.  And then when it encounters the Block C insertion, all parts of that nested Block A's definition would be changed again, this time to Layer DEF.  So the Block B definition would now contain Block A parts that are no longer on Layer ABC, but now on Layer DEF.  Are you ready for that kind of complication and potential for undesired results?

[jtm2020hyo]

good point.
you are right ... and I retract my words.

Now I will request to use beltb.lsp in multiple blocks (naming, selecting, typing "all" or wildcard "*") but just to change layers the first level inside any type of blocks (nested blocks, dynamic blocks, regular blocks)

[marko_ribar]

I think that Mr. Kent is trying to tell you that using this lisp with possibility of selecting multiple blocks could bring you undesired consequences... Here is my interpretation : suppose you have block definition "x"... You could have "x" nested into parent block "a" and also in parent "b"... Now if layer of block "a" is ABC and layer of block "b" DEF, if you apply lisp to both blocks selected "a" and "b" there is no way you can determine what layer will "x" inherit - ABC or DEF - of course it depends what block was processed firstly and what lastly, but this is unpredictable and like Kent explained, to both me and Kent it is better to leave lisp in the form where only one pick of parent block is to be processed...

I hope that now it's clear to you why no one wants to obey your request and do really simple mod... - It's not supposed to be modified...

[devitg]

Furthermore that the OP , do not show the DWG where to apply , neither  the final task to do. OP away have some to add. 

[jtm2020hyo]

Attached "beltb sample" and "beltb objective":

explaining:
I need to insert the modified beltb.lsp inside the drawing "beltb sample", that have all their entities in "layer 1" inside the blocks.

then modified-beltb.lsp should request select blocks, then the user should change their properties to "layer 2"

then the result should be the drawing "beltb objective".

notes:

1 modified-beltb.lsp should just modify the first level inside the dynamic, regular, nested block.
2 optionally modified-beltb.lsp should request any layer name, or select between existing layers, for to avoid improvised errors
3 I'm open to some suggestions and proposals.

[marko_ribar]

Sorry, I might be missing something, but by inspecting your DWGs, I don't see that you have blocks nested into parent blocks... You have normal geometry with attribute converted to dynamic block(s) with alignment parameter... My suggestion is that you change geometry and attribute under block into "0" Layer what is also standard for creating blocks... That way when you select block(s) and you change layer block(s) reside in, geometry under block(s) will inherit new color (if set "ByLayer") of layer you changed block(s) to... This is the snippet I suggest you use :

(defun c:remedyblocks ( / ss i bl bld )
  (vl-load-com)
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq bl (ssname ss (setq i (1- i))))
      (if (= (vla-get-isxref (setq bld (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename (vlax-ename->vla-object bl))))) :vlax-false)
        (vlax-for obj bld
          (vla-put-layer obj "0")
        )
      )
    )
  )
  (princ)
)

Though, code is untested...

HTH., M.R.

[Kent1Cooper]

---

@marko_ribar wrote:

.... My suggestion is that you change geometry and attribute under block into "0" Layer ....

---

That seems the best solution to me.  If so, here's one that puts everything on Layer 0 including inside the definitions of nested  Blocks.  It's a modification of >this routine< that incorporates the omissions described in Message 18 there, so that it does not apply the color and linetype of each object's original Layer to it.

It ignores objects on the DEFPOINTS Layer, because that was part of the purpose on that thread, but it could easily be made to change those to Layer 0, too.  It could also be made to force color and linetype to ByLayer, in case any objects may have overrides of such things that you want removed.

;;  BENL0.lsp [command name the same]
;;    = change all Block Entities [other than on Layer Defpoints] in selected Blocks'
;;    definitions, including in any Nested Blocks, to Layer 0
;;  Kent Cooper, edited 30 December 2019 [from BENL0CL.lsp]

(vl-load-com)
(defun C:BENL0CL (/ *error* nametolist doc blkss inc blokobj blkname blknames ent edata ldata)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (vla-endundomark doc)
    (princ)
  ); defun - *error*

  (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
    (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
      (progn
        (setq
          blkobj (vlax-ename->vla-object blk)
          blkname
            (vlax-get-property blkobj
              (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
                ; to work with older versions that don't have dynamic Blocks
            ); ...get-property & blkname
        ); setq
        (if
          (not (member blkname blknames)); name not already in list
          (setq blknames (append blknames (list blkname))); then -- add to end of list
        ); if
      ); progn
    ); if
  ); defun -- nametolist

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc); = Undo Begin

  (if (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
    (progn; then
      (repeat (setq inc (sslength blkss)); list of Block names from top-level selection
        (nametolist (ssname blkss (setq inc (1- inc))))
      ); repeat
      (while (setq blk (car blknames)); as long as there's another Block name in list
        ;; [this way instead of via (repeat) or (foreach), so it can add Nested Blocks' names to list]
        (setq ent (tblobjname "block" blk)); Block definition as entity
        (if (= (logand (cdr (assoc 70 (entget ent))) 4) 0) ; not an Xref
          (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
            (setq edata (entget ent))
            (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
            (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
              (progn ; then
                (setq ldata (entget (tblobjname "layer" (cdr (assoc 8 edata))))); entity's Layer's properties
                (setq edata (subst '(8 . "0") (assoc 8 edata) edata)); to Layer 0
                (entmod edata)
              ); progn -- then
            ); if -- not on Defpoints
          ); while -- sub-entities
        ); if
        (setq blknames (cdr blknames)); take first Block name off list
      ); while
      (command "_.regen")
    ); progn
    (prompt "\nNo Block(s) selected."); else
  ); if [user selection]
  (vla-endundomark doc); = Undo End
  (princ)
); defun

(prompt "\nType BENL0 to change all selected and nested Blocks' Entities to Layer 0.")

[Kent1Cooper]

---

@Kent1Cooper wrote:
....

....
            (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
              (progn ; then
                (setq ldata (entget (tblobjname "layer" (cdr (assoc 8 edata))))); entity's Layer's properties
                (setq edata (subst '(8 . "0") (assoc 8 edata) edata)); to Layer 0
                (entmod edata)
              ); progn -- then
            ); if -- not on Defpoints
....

---

I realized that I hadn't removed all I could have from the source routine -- it doesn't need the data from the original Layer of a given object.  The above part can be replaced with just:

....
            (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
              (entmod (subst '(8 . "0") (assoc 8 edata) edata)); then -- to Layer 0
            ); if
....

[jtm2020hyo]

thanks for your lisp.

I was testing that works with 0 errors.

about why I tried to put all entities to one layer:

I was trying to put all blocks to one selected layer because when I create one table with blocks inside, the blocks take the default color, and I need to keep all text black/white and blocks with another color. just that.

[Kent1Cooper · Accepted solution]

---

@Kent1Cooper wrote:....

....
(defun C:BENL0CL (/ *error* nametolist doc blkss inc blokobj blkname blknames ent edata ldata)
....

---

Just poked in here again and noticed that I had edited the command operations but not the command name.  That should be:

....
(defun C:BENL0 (/ *error* nametolist doc blkss inc blokobj blkname blknames ent edata ldata)
....