Jump to content

cheange all to layer 0 retain properties (linetype, color)


jim78b

Recommended Posts

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

i want that the lisp work even with normal elements/object that are not blocks.

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

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...