Jump to content

Lisp for attribute extract from block


sadhu

Recommended Posts

Quick and dirty for your specific block. Replace YOURBLOCKNAME with your block name. The attributes are stored as v1-5.

 

(defun c:test ( / e x)
   (setq e (car (entsel "\nSelect your block : "))
         x (entget e) )
   (if
       (= "YOURBLOCKNAME" (cdr (assoc 2 x)) )
       (progn
           (setq at (entnext e)
                 ax (entget at) )
               (while
                   (/= "SEQEND" (cdr (assoc 0 ax)) )
                   (cond
                       (
                         (= "DDate" (cdr (assoc 2 ax)) )
                         (setq v1 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Part" (cdr (assoc 2 ax)) )
                         (setq v2 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Sheetsize" (cdr (assoc 2 ax)) )
                         (setq v3 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Prgm" (cdr (assoc 2 ax)) )
                         (setq v4 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Name" (cdr (assoc 2 ax)) )
                         (setq v5 (cdr (assoc 1 ax)) )
                       )
                   )
                   (setq at (entnext at)
                         ax (entget at) )
               )
       )
       (princ "\nWrong block selected, you silly goose.")
   )
 (princ)
)

Link to comment
Share on other sites

  • Replies 34
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    7

  • CheSyn

    7

  • sadhu

    6

  • dpolsky

    6

Thanks, that does exactly what I asked you for!

 

However, I'm stuck on the back end of my program. I was confident if I got help this far I could do the rest my own, but as it turns out, I really don't know how to work with attributes (or entities really) in AutoLISP very well.

 

Now that I have the values stored into V1-V5. I want to click on a new Block and basically transfer the stored attributes to it, but I can't figure out from your code how to write to these blocks.

 

Thanks,

Daniel

Link to comment
Share on other sites

I wasn't sure what your new tag and block names are, so you'll have to change them again (highlighted in blue):

 

(defun c:test ( / e x)
   (setq e (car (entsel "\nSelect your block : "))
         x (entget e) )
   (if
       (= "[color=blue]YOURBLOCKNAME[/color]" (cdr (assoc 2 x)) )
       (progn
           (setq at (entnext e)
                 ax (entget at) )
               (while
                   (/= "SEQEND" (cdr (assoc 0 ax)) )
                   (cond
                       (
                         (= "DDate" (cdr (assoc 2 ax)) )
                         (setq v1 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Part" (cdr (assoc 2 ax)) )
                         (setq v2 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Sheetsize" (cdr (assoc 2 ax)) )
                         (setq v3 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Prgm" (cdr (assoc 2 ax)) )
                         (setq v4 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Name" (cdr (assoc 2 ax)) )
                         (setq v5 (cdr (assoc 1 ax)) )
                       )
                   )
                   (setq at (entnext at)
                         ax (entget at) )
               )
           (setq e (car (entsel "\nSelect the new block : "))
                 x (entget e) )
               (if
                   (= "[color=blue]YOURNEWBLOCKNAME[/color]" (cdr (assoc 2 x)) )
                   (progn
                       (setq at (entnext e)
                             ax (entget at) )
                       (while
                           (/= "SEQEND" (cdr (assoc 0 ax)) )
                           (cond
                               (
                                 (= "[color=blue]NEWTAG4V1[/color]" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v1)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "[color=blue]NEWTAG4V2[/color]" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v2)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "[color=blue]NEWTAG4V3[/color]" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v3)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "[color=blue]NEWTAG4V4[/color]" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v4)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "[color=blue]NEWTAG4V5[/color]" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v5)(assoc 1 ax) ax) )
                               )
                           )
                           (setq at (entnext at)
                                 ax (entget at) )
                       )
                   )
                   (princ "\nWrong block selected, you silly goose.")
               )               
       )
       (princ "\nWrong block selected, you silly goose.")
   )
 (princ)
)

Link to comment
Share on other sites

Hmm didn't work. I think I modified what I needed to correctly, the new block has a different name, but the tags are the same name, this is what I tried:

 

(It seems to complete the routine but with no change to the new block, and !v1-v5 are empty.

 

Thanks,

Daniel

 

(defun c:test ( / e x)
   (setq e (car (entsel "\nSelect your block : "))
         x (entget e) )
   (if
       (= "PROGRAM_TAG" (cdr (assoc 2 x)) )
       (progn
           (setq at (entnext e)
                 ax (entget at) )
               (while
                   (/= "SEQEND" (cdr (assoc 0 ax)) )
                   (cond
                       (
                         (= "DDate" (cdr (assoc 2 ax)) )
                         (setq v1 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Part" (cdr (assoc 2 ax)) )
                         (setq v2 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Sheetsize" (cdr (assoc 2 ax)) )
                         (setq v3 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Prgm" (cdr (assoc 2 ax)) )
                         (setq v4 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "Name" (cdr (assoc 2 ax)) )
                         (setq v5 (cdr (assoc 1 ax)) )
                       )
                   )
                   (setq at (entnext at)
                         ax (entget at) )
               )
           (setq e (car (entsel "\nSelect the new block : "))
                 x (entget e) )
               (if
                   (= "PROGRAM BLOCK" (cdr (assoc 2 x)) )
                   (progn
                       (setq at (entnext e)
                             ax (entget at) )
                       (while
                           (/= "SEQEND" (cdr (assoc 0 ax)) )
                           (cond
                               (
                                 (= "DDate" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v1)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "Part" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v2)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "Sheetsize" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v3)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "Prgm" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v4)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "Name" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v5)(assoc 1 ax) ax) )
                               )
                           )
                           (setq at (entnext at)
                                 ax (entget at) )
                       )
                   )
                   (princ "\nWrong block selected, you silly goose.")
               )               
       )
       (princ "\nWrong block selected, you silly goose.")
   )
 (princ)
)

Link to comment
Share on other sites

The routine reads direct quotes, so the block/tag names are case-sensitive:

(defun c:test ( / e x)
   (setq e (car (entsel "\nSelect your block : "))
         x (entget e) )
   (if
       (= "PROGRAM_TAG" (cdr (assoc 2 x)) )
       (progn
           (setq at (entnext e)
                 ax (entget at) )
               (while
                   (/= "SEQEND" (cdr (assoc 0 ax)) )
                   (cond
                       (
                         (= "DDATE" (cdr (assoc 2 ax)) )
                         (setq v1 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "PART" (cdr (assoc 2 ax)) )
                         (setq v2 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "SHEETSIZE" (cdr (assoc 2 ax)) )
                         (setq v3 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "PRGM" (cdr (assoc 2 ax)) )
                         (setq v4 (cdr (assoc 1 ax)) )
                       )
                       (
                         (= "NAME" (cdr (assoc 2 ax)) )
                         (setq v5 (cdr (assoc 1 ax)) )
                       )
                   )
                   (setq at (entnext at)
                         ax (entget at) )
               )
           (setq e (car (entsel "\nSelect the new block : "))
                 x (entget e) )
               (if
                   (= "PROGRAM BLOCK" (cdr (assoc 2 x)) )
                   (progn
                       (setq at (entnext e)
                             ax (entget at) )
                       (while
                           (/= "SEQEND" (cdr (assoc 0 ax)) )
                           (cond
                               (
                                 (= "DDATE" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v1)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "PART" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v2)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "SHEETSIZE" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v3)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "PRGM" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v4)(assoc 1 ax) ax) )
                               )
                               (
                                 (= "NAME" (cdr (assoc 2 ax)) )
                                 (entmod (subst (cons 1 v5)(assoc 1 ax) ax) )
                               )
                           )
                           (setq at (entnext at)
                                 ax (entget at) )
                       )
                   )
                   (princ "\nWrong block selected, you silly goose.")
               )               
       )
       (princ "\nWrong block selected, you silly goose.")
   )
 (princ)
)

Link to comment
Share on other sites

Awesome works perfect, thanks. I don't want it to run automatically because we have several of these blocks in the same drawing, all with the same name. I guess entmod was the command I was looking for.

 

So what is the trick to knowing all the DXF codes? Do you just know them after lots of experience, or is there a good cheat sheet somewhere?

 

Thanks,

Daniel

Link to comment
Share on other sites

FWIW, here is another way to write it as a generic program to copy attributes between blocks:
 

(defun c:test ( / myentsel des src val )
   (setq myentsel
       (lambda ( msg / ent enx )
           (while
               (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
                   (cond
                       (   (= 7 (getvar 'errno))
                           (princ "\nMissed, try again.")
                       )
                       (   (null ent) nil)
                       (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                           (princ "\nSelected object is not a block.")
                       )
                       (   (/= 1 (cdr (assoc 66 enx)))
                           (princ "\nSelected block is not attributed.")
                       )
                   )
               )
           )
           (if ent (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
       )
   )
   (if (and (setq src (myentsel "\nSelect source block: "))
            (setq des (myentsel "\nSelect destination block: "))
            (setq src (mapcar '(lambda ( x ) (cons (vla-get-tagstring x) (vla-get-textstring x))) src))
       )
       (foreach att des
           (if (setq val (cdr (assoc (vla-get-tagstring att) src)))
               (vla-put-textstring att val)
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)
 

And here is a Mac compatible version.

 

dpolsky said:
So what is the trick to knowing all the DXF codes? Do you just know them after lots of experience, or is there a good cheat sheet somewhere?

 

Here is a DXF Reference.

Edited by Lee Mac
Link to comment
Share on other sites

Awesome works perfect, thanks. I don't want it to run automatically because we have several of these blocks in the same drawing, all with the same name. I guess entmod was the command I was looking for.

 

So what is the trick to knowing all the DXF codes? Do you just know them after lots of experience, or is there a good cheat sheet somewhere?

 

Thanks,

Daniel

 

It was a slow learning process for me. I relied on the Autodesk website for the first while.

 

FWIW, here is another way to write it as a generic program to copy attributes between blocks:
([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] myentsel des src val )
([color=BLUE]setq[/color] myentsel
([color=BLUE]lambda[/color] ( msg [color=BLUE]/[/color] ent enx )
([color=BLUE]while[/color]
([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
([color=BLUE]cond[/color]
( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
)
( ([color=BLUE]null[/color] ent) [color=BLUE]nil[/color])
( ([color=BLUE]/=[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ent)))))
([color=BLUE]princ[/color] [color=MAROON]"\nSelected object is not a block."[/color])
)
( ([color=BLUE]/=[/color] 1 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 66 enx)))
([color=BLUE]princ[/color] [color=MAROON]"\nSelected block is not attributed."[/color])
)
)
)
)
([color=BLUE]if[/color] ent ([color=BLUE]vlax-invoke[/color] ([color=BLUE]vlax-ename->vla-object[/color] ent) 'getattributes))
)
)
([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] src (myentsel [color=MAROON]"\nSelect source block: "[/color]))
([color=BLUE]setq[/color] des (myentsel [color=MAROON]"\nSelect destination block: "[/color]))
([color=BLUE]setq[/color] src ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cons[/color] ([color=BLUE]vla-get-tagstring[/color] x) ([color=BLUE]vla-get-textstring[/color] x))) src))
)
([color=BLUE]foreach[/color] att des
([color=BLUE]if[/color] ([color=BLUE]setq[/color] val ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]vla-get-tagstring[/color] att) src)))
([color=BLUE]vla-put-textstring[/color] att val)
)
)
)
([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

And here is a Mac compatible version.

 

 

 

Here is a DXF Reference.

 

Very nice! I need to practice more with mapcar and lambda.

Link to comment
Share on other sites

To advoid reinvent wheels, i updated v1.1 here.

i like Lee's code is short & efficient with vlax-invoke object 'getAttributes 8) thanx!

 

i use variant-value instead of vlax-variant-value..

variant-value is undocumented but no different ?

 

(defun hp:eat$ (en l / lst ve);;v1.1
 (if (and (setq ve (vlax-ename->vla-object en))
     (vlax-safearray->list (variant-value (vla-GetAttributes ve)))
   ) ;_ end of and
   (if	l
     (mapcar '(lambda (i / o $);
	 (if
	  (and
	  (vl-some (setq $ ''((x) (= (car i) (vla-get-tagstring x)))) lst)
	  (setq o (car (vl-remove-if-not $ lst)))
	  )
	  (vla-put-textstring o (cadr (assoc (car i) l)))
	  )
	 )
      l
      ) ;_ end of mapcar
     (mapcar ''(($) (list (vla-get-tagstring $) (vla-get-textstring $))) lst)
     ) ;_ end of mapcar
   ) ;_ end of if
 ) ;_ end of defun

Just add mode feature in l (list) argument in old code. input is same the different if list=nil

(hp:eat$ ename nil), Retval list Tag & string.

if list is supplied, it overrides the attributes

Link to comment
Share on other sites

  • 1 year later...

Hi there, I know this is an old thread but it seems to be exactly what I'm looking for. However I'm absolutely confused. I reviewed the original lisp in this thread running the "SK" lisp program and it works perfectly to display the ONE tag I have in my block. So I try to apply the same idea to my lisp routine and it doesn't work.

 

In short, what I need this program to do is to rename the layout tab as the lot number designated in the block and continue to do so for each lot inside the drawing. This is my partially finished program, I don't seem to be able to get the attribute extracted properly.

 

Any suggestions? Please help me understand where I'm going wrong.

 

(defun c:LOTNUM (/ LOTNO)
(defun GETDXF (CODE ENAME)(cdr (assoc CODE (entget ENAME))))
 (setq CE-SAV (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (graphscr)
 (progn
   (setq SS (ssget "x" '((2 . "lotnum"))))
   (setq POSITION 0)
   (while (setq ENAME (ssname SS POSITION))
     (setq LYNM (GETDXF 1 ENAME))
     (setq ELOC (GETDXF 10 ENAME))
     (command "_.zoom" "_c" eloc "2xp")
     (command "_.layout" "_R"LYNM)
     (setq POSITION (1+ POSITION))
     )
   )
 )
     

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...