Lisp for attributes

Hi i have drawings with a lot blocks attributes , and i want to find a lisp to , create layers from codename attributes and move the blocks to them . It is possible?

here is an example file .

psin2.dwg

Yes. Step through the blocks, get the attribute information and check it against a predefined list (value = layer). Create the layer if it doesn't exist and change layer of block to newly defined layer.

Here it goes Buddy .

Enjoy .......

(defun c:TesT (/ ss)
 ; TharwaT 22. 03. 2011
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   ((lambda (i / sset e )
      (while
        (setq sset (ssname ss (setq i (1+ i))))
         (setq e (entget sset))
         (entmakex (list (cons 0 "LAYER")
                         (cons 100 "AcDbSymbolTableRecord")
                         (cons 100 "AcDbLayerTableRecord")
                         (cons 2 (cdr (assoc 2 e)))
                   )
         )
         (entupd
           (cdr
             (assoc
               -1
               (entmod (subst (cons 8 (cdr (assoc 2 e))) (assoc 8 e) e)
               )
             )
           )
         )
      )
    )
     -1
   )
   (princ)
 )
 (princ)
)

TharwaT

Thanks but it take the name of the block to layers but not the attribute code name , some block have the same attribute code name.

No problem , Check this out .

(defun c:TesT (/ ss)
   ; TharwaT 22. 03. 2011
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   ((lambda (i / sset e name nxt)
      (while
        (setq sset (ssname ss (setq i (1+ i))))
         (setq e (entget sset))
         (setq name (entget (setq nxt (entnext sset))))
         (entmakex (list (cons 0 "LAYER")
                         (cons 100 "AcDbSymbolTableRecord")
                         (cons 100 "AcDbLayerTableRecord")
                         (cons 2 (cdr (assoc 1 name)))
                   )
         )
         (entupd
           (cdr
             (assoc
               -1
               (entmod
                 (subst (cons 8 (cdr (assoc 1 name))) (assoc 8 e) e)
               )
             )
           )
         )
      )
    )
     -1
   )
   (princ)
 )
 (princ)
)

TharwaT

Hey you are very fast, thanks a lot . It works perfect!!!!

I was looking for this one few weeks. Thanks again.

Tharwat,

Note that this:

(cons 2 (cdr (assoc 2 e)))

could be replaced with just:

(assoc 2 e)

(for the umpteenth time...)

Also, you needn't create the layer:

(defun c:test ( / e i ss )
 (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (entmod
       (list (cons -1 (setq e (ssname ss (setq i (1- i)))))
         (cons 8 (cdr (assoc 2 (entget (entnext e)))))
       )
     )
   )
 )
 (princ)
)

Assuming the OP wants the block on the layer with a name equal to the tag of the first attribute.

Lee

Hey you are very fast, thanks a lot . It works perfect!!!!

I was looking for this one few weeks. Thanks again.

You're welcome nicpapa.

TharwaT

Lee , I agree with you according to the ..

(cons 2 (cdr (assoc 2 e)))

and it's better to be ..

(assoc 2 e)

But sometimes things are being as a matter of habit and if it does not cause a break down , it would not be pasted in mind from the first sight.

And for the routine that you provided , I can say that it is your high experienced way in dealing with lisp that I could not somehow understand

it as best as you do .

So I am still learning and have not reached the excellent way in dealing with Lisp yet .

Hope that I would be one day .

Regards,

TharwaT

Tharwat today i use the lisp , and i saw that it create layers from attribute values but it doesnt move the points blocks to the current layes, the point blocks stay to the layer points..

Tharwat today i use the lisp , and i saw that it create layers from attribute values but it doesnt move the points blocks to the current layes, the point blocks stay to the layer points..

Strange .

Can you provide a drawing to check it out ?

Ok its the first dwg i posted and i apply the lisp , if you open the file you can see that it create a layer " pasalaki" but the points block stay in layer "Poitns.

psin2 with lisp.dwg

If its not possible leave it ... And this lisp help me...

Upon viewing your drawing, the objects within your blocks are on the 'Points' layers, not the block itself.

This will move the objects in the block to Layer "0" so that they inherit the layer on which the block resides:

(defun c:test ( / b e i l s )
 (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength s))
     (if (not (member (setq b (cdr (assoc 2 (entget (setq e (ssname s (setq i (1- i)))))))) l))
       (
         (lambda ( d )
           (while (setq d (entnext d))
             (entmod (subst (cons 8 "0") (assoc 8 (entget d)) (entget d)))
           )
         )
         (tblobjname "BLOCK" (car (setq l (cons b l))))
       )
     )
     (entmod (list (cons -1 e) (cons 8 (cdr (assoc 1 (entget (entnext e)))))))
   )
 )
 (princ)
)

Lee Mac i want to add to TharwaT lisp a command to move the objects within blocks that are on the 'Points' layers and move them to the layer that created from the lisp. (attributes codenames) . Example inpsin2 with lisp.dwg‎ iw

i want to move the block from the layer point to the layer passalaki , (passalaki was the codename of attribute). In this dwg i have points with same codenames , but usually i work with several codenames.

If the block objects are on layer "0" they will inherit whatever layer the block is placed on.

Anyway, this will place those objects on the layer with name equal to the value of the first attribute found in the block.

(defun c:test ( / b e i l s x )
 (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength s))
     (entmod
       (list
         (cons -1 (setq e (ssname s (setq i (1- i)))))
         (cons  8 (setq x (cdr (assoc 1 (entget (entnext e))))))
       )
     )
     (if (not (member (setq b (cdr (assoc 2 (entget e)))) l))
       (
         (lambda ( d / a )
           (while (setq d (entnext d))
             (if (not (eq "TEXT" (cdr (assoc 0 (setq a (entget d))))))
               (entmod (subst (cons 8 x) (assoc 8 a) a))
             )
           )
         )
         (tblobjname "BLOCK" (car (setq l (cons b l))))
       )
     )
   )
 )
 (princ)
)

I'm not messing around with Tharwat's code.

last modicifation , sorry ... Can you make it the points name ( 1,2,3,5...)stay to layer Point_name and not move to other layers? Thanks alot ...the last code you post ; error: bad DXF group: (-1)

Edited above.

Lee Mac i think its ok , thank nice work with your site... its perfect keep going...thanks

to Lee Mac

It's very useful code, but not perfect in some situation

Whether it possible to modify your code so that the user could define source attribute from list-box?

sorry for my eng.