lisp to set blocks layer 0

[jim78b]

i nedd a lisp to set nested blocks to

LAYER 0

COLOR: byblock

LINETYPE: preserve the linetype of the layer who was originally is it possible? because layer 0 had continuos line and the layers in nested blocks are different linetypes...

i have this code but cheange all originally linetype because they are on different layers

 

(vl-load-com)

(defun c:BB0  (/ col cnt lop sel)
;;;---------------------------------------------------------------------------------------------------------------------
; Dynamic blocks don't update and I dont know why. Vla-update doesnt work. Vla-resetBlock works but all dynamic parametres are lost.
;;; subroutines
  ;; remove duplicated items in list
  (defun LM:unique  (l) ; by Lee Mac
    (if l
      (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; set "by block" to all entities in block definition
  (defun BB0:setByBlock  (nam / blc blk)
    (setq blc (vla-get-blocks (vla-get-activedocument
(vlax-get-acad-object))))
    (setq blk (vla-item blc nam))
    (vlax-for x  blk
      (vla-put-layer x "0")
      (vla-put-color x acByBlock)
      (vla-put-linetype x "ByBlock")
      (vla-put-linetypescale x 1.0)
;;;      (vla-put-lineweight x acLnWtByLayer)
;;;      (vla-put-entityTransparency x "ByBlock:")
;;;      (vla-put-material x "ByBlock")
      (if (eq (vla-get-objectName x) "AcDbBlockReference")
        (BB0:setByBlock (vla-get-effectiveName x))))
      )
;;;---------------------------------------------------------------------------------------------------------------------
;;; main
  (setq lop t)
  (while lop
    (princ "\nSelect blocks: ")
    (if (setq sel (ssget '((0 . "INSERT"))))
      (progn (setq cnt 0)
             (setq col nil)
             (repeat (sslength sel)
               (setq obx (vlax-ename->vla-object (ssname sel
cnt)))
               (setq col (cons (vla-get-effectiveName obx) col))
             (setq cnt (1+ cnt)))
      (setq col (LM:unique col))
      (foreach x col (BB0:setByBlock x))
      (setq lop nil))
    (princ "\nNo selection")))
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
acActiveViewport)
(princ))

 

[ronjonp]

Make these highlighted modifications:

[jim78b]

thanks you are so kind , i found a lisp that works!

 

;;  BN.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.")

[ronjonp]

@jim78b When posting code please use the code tags:

 

GIF posted below for some reason..

Edited May 29, 2019 by ronjonp

[ronjonp]

[jim78b]

oh sorry excuse me

[ronjonp]

1 minute ago, jim78b said:

oh sorry excuse me

No need to be sorry .. just trying to teach you something new 

[jim78b]

yes ! now i know!

[ronjonp]

5 minutes ago, jim78b said:

yes ! now i know!

Glad to help

[jim78b]

can you modify it so that with double command I can also modify the elements that are not in the blocks? please