Topic: Block Attribute to Layer?

[MSTG007]

I had a guy ask if there was a lisp that could find a block name, then the contents (value) of that block and then create or move that block to a layer of the value.

So if the block name was REV, and REV block was copied 3 different times with different values (1, 2, 3), then create layers or move to the layer if it is already created.

Thanks for any input!

[ribarm]

Of course that this is possible, but why such routine? And what if layer with such definition already exist in drawing and have many other entity types residing to it, wouldn't that be complication? So as many different blocks - as many different layers each containing corresponding block, what for...? Is it for QSELECT blocks - you can filter that inside filter of (ssget) - name of block... Why filter by attribute value, what can you achieve, count of such blocks with (sslength)? You already have dataextraction command, so you can see number of occurs and preview of complete data of blocks inside drawing...

[MSTG007]

Heres what he is trying to do. He has a lot of old drawings with revisions. The REV block is on its own layer, apart from the cloud layer. he wants that block to be with the cloud layer. Right now, when he isolates a layer the REV is off, but if he turns it on, all of the REVs show up. I think he just wants something he can run which puts in on the right layer as the cloud.

[ribarm]

Anyway, here is my attempt... Untested...

Code: [Select]

(defun c:blks+atts2layers ( / bll ss sss s i ent atts attt atttl layn )

  (vl-load-com)

  (setq bll (ai_table "BLOCK" 4))
  (foreach bl bll
    (if
      (eq
        (vla-get-isxref
          (vla-item
            (vla-get-blocks
              (vla-get-activedocument
                (vlax-get-acad-object)
              )
            )
            bl
          )
        )
        :vlax-false
      )
      (progn
        (setq ss (ssget "_X" '((0 . "INSERT"))))
        (setq sss (ssadd))
        (repeat (setq i (sslength ss))
          (setq ent (ssname ss (setq i (1- i))))
          (if (eq (cdr (assoc 2 (entget ent))) bl)
            (ssadd ent sss)
          )
        )
        (setq s (ssadd))
        (repeat (setq i (sslength sss))
          (setq ent (ssname sss (setq i (1- i))))
          (if (not (eq (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))) 4))
            (ssadd ent s)
          )
        )
        (if s
          (repeat (setq i (sslength s))
            (setq ent (ssname s (setq i (1- i))))
            (if (eq 1 (cdr (assoc 66 (entget ent))))
              (progn
                (setq atts (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
                (foreach att atts
                  (setq attt (vla-get-textstring att))
                  (setq atttl (cons attt atttl))
                )
                (setq atttl (reverse atttl))
                (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2) "-") (strcat bl "-")))
                (foreach attt atttl
                  (setq layn (strcat layn "-" attt))
                )
                (if (not (tblsearch "LAYER" layn))
                  (command "_.-LAYER" "_M" layn "")
                )
                (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
                (setq layn nil atttl nil)
              )
              (progn
                (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2)) bl))
                (if (not (tblsearch "LAYER" layn))
                  (command "_.-LAYER" "_M" layn "")
                )
                (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
                (setq layn nil)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

M.R.

[ribarm]

MSTG007, you're not responding... Was above posted code what you're looking for?

Here are my setup functions...

Normal blocks with attributes :

Code: [Select]

(defun c:mknblks+atts ( / k n p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 )
  (setq k 0)
  (initget 7)
  (setq n (getint "\nSpecify number of block insertions groups : "))
  (repeat n
    (setq k (1+ k))
    (setq p0 (list (float (* k 10)) 0.0 0.0))
    (setq p1 (polar p0 (/ pi 2.0) 1.0))
    (setq p2 (polar p1 (/ pi 2.0) 1.0))
    (setq p3 (polar p2 (/ pi 2.0) 1.0))
    (setq p4 (polar p3 (/ pi 2.0) 1.0))
    (setq p5 (polar p4 (/ pi 2.0) 1.0))
    (setq p6 (polar p5 (/ pi 2.0) 1.0))
    (setq p7 (polar p6 (/ pi 2.0) 1.0))
    (setq p8 (polar p7 (/ pi 2.0) 1.0))
    (setq p9 (polar p8 (/ pi 2.0) 1.0))
    (entmake (list (cons 0 "BLOCK")(cons 2 (itoa k))(cons 70 0)(cons 10 p0)))
    (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 1 (itoa k)) (cons 10 p0) (cons 40 0.5)))
    (entmake (list (cons 0 "ATTDEF") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "") (cons 3 "") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD") (cons 11 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1))))
    (entmake (list (cons 0 "ATTDEF") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "") (cons 3 "") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD") (cons 11 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1))))
    (entmake '((0 . "ENDBLK")))
   
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p0)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p1)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p1 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p1 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p2)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p2 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p2 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p3)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p3 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p3 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p4)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p4 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p4 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p5)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p5 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p5 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p6)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p6 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p6 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p7)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p7 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p7 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p8)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p8 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p8 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 (itoa k)) (cons 10 p9)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p9 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p9 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
  )
  (princ)
)

Anonymous blocks with attributes :

Code: [Select]

(defun c:mknanonblks+atts ( / k n p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 ab )
  (setq k 0)
  (initget 7)
  (setq n (getint "\nSpecify number of block anonymous insertions groups : "))
  (repeat n
    (setq k (1+ k))
    (setq p0 (list (float (* k 10)) 0.0 0.0))
    (setq p1 (polar p0 (/ pi 2.0) 1.0))
    (setq p2 (polar p1 (/ pi 2.0) 1.0))
    (setq p3 (polar p2 (/ pi 2.0) 1.0))
    (setq p4 (polar p3 (/ pi 2.0) 1.0))
    (setq p5 (polar p4 (/ pi 2.0) 1.0))
    (setq p6 (polar p5 (/ pi 2.0) 1.0))
    (setq p7 (polar p6 (/ pi 2.0) 1.0))
    (setq p8 (polar p7 (/ pi 2.0) 1.0))
    (setq p9 (polar p8 (/ pi 2.0) 1.0))
    (entmake (list (cons 0 "BLOCK")(cons 2 "*U")(cons 70 1)(cons 10 p0)))
    (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 1 (itoa k)) (cons 10 p0) (cons 40 0.5)))
    (entmake (list (cons 0 "ATTDEF") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "") (cons 3 "") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD") (cons 11 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1))))
    (entmake (list (cons 0 "ATTDEF") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "") (cons 3 "") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD") (cons 11 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1))))
    (setq ab (entmake '((0 . "ENDBLK"))))
   
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p0)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p0 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p1)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p1 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p1 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p2)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p2 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p2 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p3)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p3 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p3 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p4)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p4 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p4 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p5)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p5 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p5 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p6)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p6 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p6 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p7)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p7 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p7 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p8)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p8 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p8 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
    (entmake (list (cons 0 "INSERT") (cons 66 1) (cons 2 ab) (cons 10 p9)))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p9 (* 1.5 pi) 0.1) pi 0.1)) (cons 40 0.2) (cons 1 "1") (cons 2 "1") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "ATTRIB") (cons 10 (polar (polar p9 (* 1.5 pi) 0.1) 0.0 0.1)) (cons 40 0.2) (cons 1 "2") (cons 2 "2") (cons 70 0) (cons 7 "STANDARD")))
    (entmake (list (cons 0 "SEQEND")))
  )
  (princ)
)

HTH, M.R.
Please reply if something wasn't as it should, or if that is what you're looking for (I am glad I could help)...

[MSTG007]

hey, sorry about that... Was very busy. Let me give it a go! Thank you for your help so far!!!

[MSTG007]

Ok i had a chance to work with it! for the most part it does what I need it to do. Hopefully these suggestions are still possible with the code.
- The block I would like to filter or find name is "REVS"
- Could I get the layer to be REV1, REV2, etc. (That is what the layer of the clouds are on).

Its an awesome piece of code! Great Job!

[ribarm]

Ok i had a chance to work with it! for the most part it does what I need it to do. Hopefully these suggestions are still possible with the code.
- The block I would like to filter or find name is "REVS"
- Could I get the layer to be REV1, REV2, etc. (That is what the layer of the clouds are on).

Its an awesome piece of code! Great Job!

Thanks for your reply, now I know I am on right path...
Try this revision, for single block input :

Code: [Select]

(defun c:blk+atts2layer ( / loop bl ss sss s i ent atts attt atttl layn )

  (vl-load-com)

  (setq loop t)
  (while loop
    (cond
      ( (eq (setq bl (getstring t "\nSpecify name of block to put into it's layer : ")) "")
        (prompt "\nSpecified name of block isn't valid string... Try again with different name...")
      )
      ( (not (tblsearch "BLOCK" bl))
        (prompt "\nSpecified name of block doesn't exist in active document... Try again with different name...")
      )
      ( (eq (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) bl)) :vlax-true)
        (prompt "\nSpecified name of block belongs to attached xref in active document... Try again with different name...")
      )
      ( t (setq loop nil))
    )
  )
  (if bl
    (progn
      (setq ss (ssget "_X" '((0 . "INSERT"))))
      (setq sss (ssadd))
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (if (eq (cdr (assoc 2 (entget ent))) bl)
          (ssadd ent sss)
        )
      )
      (setq s (ssadd))
      (repeat (setq i (sslength sss))
        (setq ent (ssname sss (setq i (1- i))))
        (if (not (eq (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))) 4))
          (ssadd ent s)
        )
      )
      (if s
        (repeat (setq i (sslength s))
          (setq ent (ssname s (setq i (1- i))))
          (if (eq 1 (cdr (assoc 66 (entget ent))))
            (progn
              (setq atts (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
              (foreach att atts
                (setq attt (vla-get-textstring att))
                (setq atttl (cons attt atttl))
              )
              (setq atttl (reverse atttl))
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2) "-") (strcat bl "-")))
              (foreach attt atttl
                (setq layn (strcat layn "-" attt))
              )
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil atttl nil)
            )
            (progn
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2)) bl))
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil)
            )
          )
        )
      )
    )
  )
  (princ)
)


[MSTG007]

That works. Can I have it, where I can select the block instead of typing it?

Also, Can you add you add a find and replace in front of the lisp. I could get the layers to work by renaming the block from REVS to REV and then it worked correctly!

[ribarm]

That works. Can I have it, where I can select the block instead of typing it?

Also, Can you add you add a find and replace in front of the lisp. I could get the layers to work by renaming the block from REVS to REV and then it worked correctly!

Code: [Select]

(defun c:blk+atts2layer-pick ( / loop e bl ss sss s i ent atts attt atttl layn )

  (vl-load-com)

  (setq loop t)
  (while loop
    (while (not (eq (cdr (assoc 0 (entget (setq e (car (entsel "\nPick block to put into it's layer : ")))))) "INSERT"))
      (prompt "\nPicked entity doesn't belong to INSERT reference... Try picking again...")
    )
    (setq bl (cdr (assoc 2 (entget e))))
    (if (eq (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) bl)) :vlax-true)
      (prompt "\nSpecified name of block belongs to attached xref in active document... Try again with different name...")
      (setq loop nil)
    )
  )
  (if bl
    (progn
      (setq ss (ssget "_X" '((0 . "INSERT"))))
      (setq sss (ssadd))
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (if (eq (cdr (assoc 2 (entget ent))) bl)
          (ssadd ent sss)
        )
      )
      (setq s (ssadd))
      (repeat (setq i (sslength sss))
        (setq ent (ssname sss (setq i (1- i))))
        (if (not (eq (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))) 4))
          (ssadd ent s)
        )
      )
      (if s
        (repeat (setq i (sslength s))
          (setq ent (ssname s (setq i (1- i))))
          (if (eq 1 (cdr (assoc 66 (entget ent))))
            (progn
              (setq atts (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
              (foreach att atts
                (setq attt (vla-get-textstring att))
                (setq atttl (cons attt atttl))
              )
              (setq atttl (reverse atttl))
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2) "-") (strcat bl "-")))
              (foreach attt atttl
                (setq layn (strcat layn "-" attt))
              )
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil atttl nil)
            )
            (progn
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "-" (substr bl 2)) bl))
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil)
            )
          )
        )
      )
    )
  )
  (princ)
)

HTH, M.R.

[MSTG007]

Ok. I have the code cleaned up for the use I need it. I have two more Lisps I would like to incorporate into yours.

This makes the select block to layer 0.

Code: [Select]

(defun LM:BlockObjectstoLayer ( block layer )
  (vl-load-com)
  ;; © Lee Mac 2010
  (if
    (not
      (vl-catch-all-error-p
        (setq def
          (vl-catch-all-apply 'vla-item
            (list
              (vla-get-blocks
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)
                )
              )
              block
            )
          )
        )
      )
    )
    (vlax-for obj def
      (vl-catch-all-apply 'vla-put-layer (list obj layer))
    )
  )
)

(defun c:test ( / e )

  (if (and (setq e (car (entsel)))
           (eq "INSERT" (cdr (assoc 0 (entget e)))))
   
    (LM:BlockObjectstoLayer (cdr (assoc 2 (entget e))) "0")
  )

  (command "_.regenall")

  (princ)
)

This one changes the ATTRIBUTE value to Layer 0.

Code: [Select]

(defun c:att2lay0 ( / e i s x )
    (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength s))
            (setq e (entnext (ssname s (setq i (1- i))))
                  x (entget e)
            )
            (while (= "ATTRIB" (cdr (assoc 0 x)))
                (entmod (subst '(8 . "0") (assoc 8 x) x))
                (setq e (entnext e)
                      x (entget  e)
                )
            )
        )
    )
    (princ)
)

Below is the code that works great!

Code: [Select]

(defun c:blk+atts2layer-pick ( / loop e bl ss sss s i ent atts attt atttl layn )

  (vl-load-com)










(vla-put-Name
  (vla-item
    (vla-get-Blocks
      (vla-get-ActiveDocument
        (vlax-get-acad-object)
      )
    )
  "REVS") ;;;<-- old block name
  "REV") ;;;< -- new block name





  (setq loop t)
  (while loop
    (while (not (eq (cdr (assoc 0 (entget (setq e (car (entsel "\nPick block to put into it's layer : ")))))) "INSERT"))
      (prompt "\nPicked entity doesn't belong to INSERT reference... Try picking again...")
    )
    (setq bl (cdr (assoc 2 (entget e))))
    (if (eq (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) bl)) :vlax-true)
      (prompt "\nSpecified name of block belongs to attached xref in active document... Try again with different name...")
      (setq loop nil)
    )
  )
  (if bl
    (progn
      (setq ss (ssget "_X" '((0 . "INSERT"))))
      (setq sss (ssadd))
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (if (eq (cdr (assoc 2 (entget ent))) bl)
          (ssadd ent sss)
        )
      )
      (setq s (ssadd))
      (repeat (setq i (sslength sss))
        (setq ent (ssname sss (setq i (1- i))))
        (if (not (eq (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent))))))) 4))
          (ssadd ent s)
        )
      )
      (if s
        (repeat (setq i (sslength s))
          (setq ent (ssname s (setq i (1- i))))
          (if (eq 1 (cdr (assoc 66 (entget ent))))
            (progn
              (setq atts (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
              (foreach att atts
                (setq attt (vla-get-textstring att))
                (setq atttl (cons attt atttl))
              )
              (setq atttl (reverse atttl))
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "" (substr bl 2) "") (strcat bl "")))
              (foreach attt atttl
                (setq layn (strcat layn "" attt))
              )
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil atttl nil)
            )
            (progn
              (setq layn (if (eq (substr bl 1 1) "*") (strcat "" (substr bl 2)) bl))
              (if (not (tblsearch "LAYER" layn))
                (command "_.-LAYER" "_M" layn "")
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 8 layn) (assoc 8 (entget ent)) (entget ent))))))
              (setq layn nil)
            )
          )
        )
      )
    )
  )
 )
)


    (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength s))
            (setq e (entnext (ssname s (setq i (1- i))))
                  x (entget e)
            )
            (while (= "ATTRIB" (cdr (assoc 0 x)))
                (entmod (subst '(8 . "0") (assoc 8 x) x))
                (setq e (entnext e)
                      x (entget  e)
                )
            )
        )
    )
    (princ)
)