retain block retain lineweight on layer 0

[jim78b]

hello i have this lisp that retain of a block linetype and color and put all to layer 0, i need even to retain lineweight please

;;  BN0.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 with Color & Linetype
;;    overrides from entity's source layer properties [if not otherwise overridden]
;;  Kent Cooper, last edited 4 November 2014

(vl-load-com)
(defun C:BN0 (/ *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
                (if
                  (or ; [no Color override]
                    (not (assoc 62 edata)); Bylayer
                    (member '(62 . 0) edata); Byblock
                  ); or
                  (setq edata (append edata (list (assoc 62 ldata)))); then -- assign Layer's color
                ); if
                (if
                  (and
                    (or ; [no Linetype override]
                      (not (assoc 6 edata)); Bylayer
                      (member '(6 . "ByBlock") edata)
                    ); or
                    (not (member '(6 . "Continuous") ldata))
                      ; don't override ByLayer/ByBlock with Layer's linetype if Continuous
                  ); and
                  (setq edata (append edata (list (assoc 6 ldata)))); then -- assign Layer's linetype
                ); if
                (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 BENL0CL to change all selected Blocks' Entities to Layer 0 retaining their Layers' color/linetype.")

 

[Emmanuel Delay]

Lineweight is 370

So I did the same thing as 6 (linetype) for 370.  Skipping ByLayer , which means it doesn't have a 370 (but byBlock or default is not a problem, I think).

Lines 73->77

 

See if it does what you need.  Try testing it for difficult cases, put in a few byLayer, byBlock, default, ...

 

;;  BN0.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 with Color & Linetype
;;    overrides from entity's source layer properties [if not otherwise overridden]
;;  Kent Cooper, last edited 4 November 2014

(vl-load-com)
(defun C:BN0 (/ *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
                (if
                  (or ; [no Color override]
                    (not (assoc 62 edata)); Bylayer
                    (member '(62 . 0) edata); Byblock
                  ); or
                  (setq edata (append edata (list (assoc 62 ldata)))); then -- assign Layer's color
                ); if
                (if
                  (and
                    (or ; [no Linetype override]
                      (not (assoc 6 edata)); Bylayer
                      (member '(6 . "ByBlock") edata)
                    ); or
                    (not (member '(6 . "Continuous") ldata))
                      ; don't override ByLayer/ByBlock with Layer's linetype if Continuous
                  ); and
                  (setq edata (append edata (list (assoc 6 ldata)))); then -- assign Layer's linetype
                ); if                
                (if
                  (not (assoc 370 edata)); Bylayer; [no Linetype override]
                  ;; don't override ByLayer
                  (setq edata (append edata (list (assoc 370 ldata)))); then -- assign Layer's lineweight
                ); if
                (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 BN0 to change all selected Blocks' Entities to Layer 0 retaining their Layers' color/linetype/lineweight.")

Edited November 25, 2019 by Emmanuel Delay

[jim78b]

thanks perfect!