LISP to change a specific attribute from a specific block to a specific value

[jlangston]

I've had a simple lisp I've been using for years that suddenly disappeared.  It required that you identify a block name, tag name, and the value that you want the tag to be.  All of this is performed via command line, so it is scriptable.  Since I lost it, I've been experimenting with -attedit.  This command comes frustratingly close to what I'm looking for, except it only appends an existing tag, or replaces a specific string within the tag; I can't get it to replace the entire tag, regardless of its value.

1> does anyone have a lisp routine that does what I describe?

or

2> does anyone know how to make -attedit replace a tag value without regard to what the value currently is (like a * wildcard)?

[_Tharwat]

Hi .

What is the name of your block(s) and the tag string to change and the string to be replaced ?

If a simple drawing with the attributed block attached , would be very helpful for one shot . 

Tharwat

[jlangston]

Attached is a simple mockup DWG of what I am referring to.  It contains two blocks--one called ellipse, and one called rectangle.  Each block has three attributes, tag1, tag2, and tag3.  The LISP needs to be able to change a specific tag from a specific block definition, such that a different block definition with the same tag names is not affected, e.g. change the value of the attribute tag "tag2" in block "rectangle" to the value "abc" without changing the attribute tag "tag2" in the block definition "ellipse".  The choice of which block definition and which attribute tag is user supplied via command line.  This allows for automated scripting.  Does this help?

[_Tharwat]

Hi ,

You did not mention which tag you would like to change so I considered TAG1 as a start at the moment , so I have no problem to change it as you wish if needed .

(defun c:TesT (/ st ss i n e x)
  ;; Tharwat 08. Dec. 2011 ;;
  (if
    (and (not
           (eq (setq st (getstring t "\n Enter string for attribute TAG1 :"))
               ""
           )
         )
         (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    )
     (repeat (setq i (sslength ss))
       (setq n (entnext (ssname ss (setq i (1- i)))))
       (while
         (not
           (eq (cdr (assoc 0 (setq e (entget n))))
               "SEQEND"
           )
         )
          (if (eq (cdr (assoc 1 e)) "TAG1")
            (entmod (subst (cons 1 st) (assoc 1 e) e))
          )
          (setq n (entnext n))
       )
     )
  )
  (princ)
)

[Hallex]

my 2 cents

;;;============================code start==============================

  (vl-load-com)
(defun C:ATTC  (/ alist1 alist2 attrecord objlist sset)
  
   ;; local defun
   ;; sets attribute values to block from list of pairs
  (defun put-attributes (blockref assocList / attObj attObjList)
  (setq attObjList (vlax-invoke blockref 'getattributes))
  (foreach attObj attObjList
    (if (setq attRecord (assoc (strcase (vla-get-tagString attObj)) assocList))
      (vla-put-TextString attObj (cdr attRecord))
    )
  )
)

  ;; build your own lists of pairs instead:
    (setq alist1 (list
                   (cons "TAG1" "aaa")
                   (cons "TAG2" "bbb")
                   (cons "TAG3" "ccc")));<-for block "ellipse"
      (setq alist2 (list
                   (cons "TAG1" "eee")
                   (cons "TAG2" "fff")
                   (cons "TAG3" "ggg")));<-for block "rectangle"

    (if (setq sset  (ssget "_X" (list (cons 0  "INSERT");<-entity dxf name
                                      (cons 66  1);<-- has attributes
                                      ;(cons 2  "ELLIPSE,RECTANGLE");<-- block names to change OR:
                                      (cons 2  "ellipse,rectangle");<-- block names to change non case-sensitive
                                      )))
      (progn
        (setq objList ( mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex sset))))
(foreach blockObj objList
  (cond((eq "ELLIPSE" (strcase (vla-get-effectivename blockObj)))
        (put-attributes blockObj alist1))
       ((eq "RECTANGLE" (strcase (vla-get-effectivename blockObj)))
        (put-attributes blockObj alist2))))
                       )
      )
    (princ)
  )

(prompt "\nStart command with ATTC to change attribute values.")
(prin1)
;;;=============================code end=============================

~'J'~

[jlangston]

Tharwat,

When I run your lisp routine, nothing happens to the tag name after I select it.

Hallex,

Your lisp works great. As far as I can tell, it requires direct change of the lisp code to change the parameters, as opposed to being users choice within Autocad--differen't, but I can get used to it, so thank you very much.

As an aside, I've managed to get -attedit to work in a limited way via the following command string:

(command "-attedit" "y" "BLOCK_NAME" "TAG_NAME" "" "-999999,-999999" "999999,999999" "" "v" "r" "TAG_VALUE" "")

It only works on a single instance of a block however, which is usually ok; your solution is more flexable however.

If anyone is interested in persuing this further, the original form of the lisp I lost allowed for user input in the following format:

(Glblattchg "BLOCK_NAME" "TAG_NAME" "TAG_VALUE")

This allowed for easy scripting because all the user input could be assembled beforehand on a single line of text for each attribute, and repeated within a script a dozen times per drawing without much trouble.  Hallex's solution operates in a similar fashion, but the script has to be written within the lisp expression itself.  It does 95% of what I was hoping it would do though, and that's 95% more than I had without it, so again thanks for your help.

[stevor]

Not sure whether you want to change the TAG string or the value; here is  a TAG string changer.

There may be shorter ways, this one is explicit.

 ; 20-May-09 NEHolt / mod 7DEC11 auscadd
 ; attr_rename_list  subject BLOCK, TAG name, New tag name
 (defun Blk_TagRen ( sbn  stn  ntn / bnl ss si mbqi ebn edl
         BIen nen  ndl  etn )    
  ; all inserts of block sbn  /? in active drawing  
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 sbn) )))
    (progn
      (setq si 0  mbiq 0 ) ;ss indexer,  matched blk inserts
      (while (< si (sslength ss) )
        (setq BIen (ssname ss si)  si (1+ si) ) ; Blk Insert Ent Name
        (setq nen (entnext BIen)  seekf t )  
        (while (AND  seekf  nen  (setq edl (entget nen))
                (/= (dxf_ 0 edl) "SEQEND")
                (/= (dxf_ 0 edl) "INSERT") ) ; and
          (if (and (= (dxf_ 0 edl) "ATTRIB")
                   (setq etn (dxf_ 2 edl))  
                   (wcmatch etn stn ) ) ; ent tag, subj tag
            (progn ; match: change  
              (setq ndl (subst (cons 2 ntn) (assoc 2 edl) edl))
              (entmod ndl )  (entupd BIen)
              (princ (strcat "\n " etn " to " ntn) )
              (setq mbiq (1+ mbiq)  seekf nil ) ; 1 find flag
            )
          )   ; go to next sub ent  
          (setq nen (entnext nen))  
        )  
    )
    (princ (strcat "\n Inserts of " sbn " found: "
            (itoa (sslength ss)) ", changed Tag: " stn
            " to " ntn " : " (itoa mbiq) ))
   ) (princ (strcat "\n No Inserts Found of: " sbn)) )
 (princ) ) ; def
      
 (princ" loaded ")   
 (  Blk_TagRen "rectangle" "TAG2"  "abc" )
 (princ"\n done ")  

[stevor]

Reply to self: omitted a subr:

 (defun dxf_ (n alst) (cdr (assoc n alst)) )

Plus there is another thread that may do about the same:

 Modify this LISP to select ALL blocks and replace attr prompt

[pbejse · Accepted solution]

(defun Glblattchg (bn Tg Tv / aDoc ss)
  (vl-load-com)
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cond
    ((and
       (ssget
         "_x"
         (list '(0 . "INSERT") (cons 2 (strcat bn ",`*U*")))
         )
       (vlax-for
          itm (setq ss (vla-get-ActiveSelectionSet aDoc))
         (if (and
               (eq (strcase (vla-get-EffectiveName itm)) (strcase bn))
               (setq itm (assoc
                 (strcase tg)
                 (mapcar
                   (function
                     (lambda (j)
                       (list
                         (vla-get-tagstring j)
                         (vla-get-textstring j)
                         j
                         )
                       )
                     )
                   (vlax-invoke itm 'GetAttributes)
                   )
                 )
                 )
               )(vla-put-textstring (last itm) tv)
           
           )
         )
       (vla-delete ss)
       )
     )
    )
  )

 (GLBLATTCHG "Rectangle" "Tag3" "NewValue")

HTh

[_Tharwat]

---

@Anonymous wrote:

Tharwat,

When I run your lisp routine, nothing happens to the tag name after I select it.

---

The routine works as the following :

first the routine would ask you to type the text you want to replace it with the one in the attributed block .

second you should select the attributed block as the ones you have uploaded in this thread earlier .

things worked perfectly for me .

[jlangston]

pbejse,

Your lisp not only works, but it works exactly as I was hoping it would.  I didn't expect to get an exact replacement to my missing lisp, but I got one anyway, and a concise one at that.  Thank you.

Thank you also to everyone else who contributed to this thread.  Every time I try to solve a problem like this I'm always amazed at how different each persons approach is to the solution.  I consider this topic resolved.

Regards.

[pbejse]

---

@Anonymous wrote:

pbejse,

Your lisp not only works,........Thank you.

Regards.

---

Good for you jlangston. Glad i could help

Cheers

[bradwitt1976]

I have a similar issue that I am trying to modify these lisp routines to fit for me and I am having no luck. Attached is a typical title block block that I use to insert into multiple files. I would like to find a way to script the changes of the issuances for multiple files with multiple tabs per file, sometimes around 200 + sheets total. Now more time than not it will not be the same issuance line in each file so I would like it to find the next line available, I am using ACAD 2013 if that makes any difference. Thank you for any help. 

[andy_gs_99]

Hello Friends,

I have simple lisp which calucalates weight of the part . I want that weight to update automatically in the title block in WEIGHT promt, and also i want the file name to update in CAT# promt (need to remove prefix "rem", just the nummber)

I have attached template and aslo lisp whcih calucaltes the weight.

;;;To calucalate area & weight
(defun c:WT()
(COMMAND "OSNAP" "")
(setq g1(getpoint "pick the point inside the boundry of the Plate :.."))
(setq a(getreal "\nEnter the plate Thickness: "))
(command "-boundary" g1 "")
(command "area" "o" "l" )
(command "erase" "l" "")
(setq g2(getvar "area"))
(setq aa "    AREA :  ")
(setq g3(rtos g2))
(setq tt(* g2 0.2836 a))
(setq g4(rtos TT))
(setq NN "
")
(setq cc "WEIGHT :  ")
(setq KK " Pounds.")
(setq bb(strcat aa g3 NN NN CC G4 KK))
;(alert bb)
(setq b1(strcat aa g3 NN CC G4 KK))
;(textscr)
)

[andy_gs_99]

Hello Friends,

I have simple lisp which calucalates weight of the part . I want that weight to update automatically in the title block in WEIGHT promt, and also i want the file name to update in CAT# promt (need to remove prefix "rem", just the nummber)

I have attached template and aslo lisp whcih calucaltes the weight.

;;;To calucalate area & weight
(defun c:WT()
(COMMAND "OSNAP" "")
(setq g1(getpoint "pick the point inside the boundry of the Plate :.."))
(setq a(getreal "\nEnter the plate Thickness: "))
(command "-boundary" g1 "")
(command "area" "o" "l" )
(command "erase" "l" "")
(setq g2(getvar "area"))
(setq aa "    AREA :  ")
(setq g3(rtos g2))
(setq tt(* g2 0.2836 a))
(setq g4(rtos TT))
(setq NN "
")
(setq cc "WEIGHT :  ")
(setq KK " Pounds.")
(setq bb(strcat aa g3 NN NN CC G4 KK))
;(alert bb)
(setq b1(strcat aa g3 NN CC G4 KK))
;(textscr)
)

[andy_gs_99]

Hello Friends,

I have simple lisp which calucalates weight of the part . I want that weight to update automatically in the title block in WEIGHT promt, and also i want the file name to update in CAT# promt (need to remove prefix "rem", just the nummber)

I have attached template and aslo lisp whcih calucaltes the weight.

;;;To calucalate area & weight
(defun c:WT()
(COMMAND "OSNAP" "")
(setq g1(getpoint "pick the point inside the boundry of the Plate :.."))
(setq a(getreal "\nEnter the plate Thickness: "))
(command "-boundary" g1 "")
(command "area" "o" "l" )
(command "erase" "l" "")
(setq g2(getvar "area"))
(setq aa "    AREA :  ")
(setq g3(rtos g2))
(setq tt(* g2 0.2836 a))
(setq g4(rtos TT))
(setq NN "
")
(setq cc "WEIGHT :  ")
(setq KK " Pounds.")
(setq bb(strcat aa g3 NN NN CC G4 KK))
;(alert bb)
(setq b1(strcat aa g3 NN CC G4 KK))
;(textscr)
)

[pbejse]

Try

(defun c:wt (/ fn tblock plate a weight data)
  (cond
    ((and
       (= (getvar 'Dwgtitled) 1)
       (setq fn (vl-filename-base (getvar 'Dwgname)))
       (not
	 (eq fn (setq pre (vl-string-right-trim "0123456789" fn)))
       )
       (setq tblock (ssget "_x" '((0 . "INSERT") (2 . "TITLE"))))
       (setq tblock (if	(> (sslength tblock) 1)
		      nil
		      tblock
		    )
       )
       (princ "\nselect Polyline:")
       (setq plate (ssget "_:S:E" '((0 . "LWPOLYLINE"))))
       (setq a (getreal "\nEnter the plate Thickness: "))
       (setq plate (vlax-ename->vla-object (ssname plate 0)))
       (setq weight (* (setq area (vla-get-area plate)) 0.2836 a))
       (setq data (list
		    (cons "PLATE#" (vl-string-subst "" pre fn))
		    (cons "WEIGHT" (rtos weight 2 0))
		    (cons "THICKNESS" (rtos a 4))
		  )
       )
     )
     (not
       (mapcar
	 '(lambda (x)
	    (if	(setq y (assoc (strcase (vla-get-tagstring x)) data))
	      (vla-put-textstring x (cdr y))
	    )
	  )
	 (vlax-invoke
	   (vlax-ename->vla-object (ssname tblock 0))
	   'Getattributes
	 )
       )
     )
     (princ (strcat "\n\tArea:    "
		    (rtos area)
		    "\n\tWeigth : "
		    (rtos weight)
	    )
     )
    )
  )
  (princ)
)

 or would you rather be prompted for block selection

......

(princ "\nselect Title Block:")
(setq tblock (ssget "_+.:S:E:L" '((0 . "INSERT") (2 . "TITLE"))))

.......

and remove this line

(setq tblock (if (> (sslength tblock) 1) nil tblock))
.......

HTH

[pbejse]

---

@bradwitt1976 wrote:

I have a similar issue that I am trying to modify these lisp routines to fit for me and I am having no luck. Attached is a typical title block block that I use to insert into multiple files. I would like to find a way to script the changes of the issuances for multiple files with multiple tabs per file, sometimes around 200 + sheets total. Now more time than not it will not be the same issuance line in each file so I would like it to find the next line available, I am using ACAD 2013 if that makes any difference. Thank you for any help. 

---

Can't convert any cad files on my netbook. I'll ask somebody to convert the attachement and then we'll have a look see.

[andy_gs_99]

Super! Wroks great... thanks a lot pbejse  for your time. I need minor adjustment to the code. The plate shape may be irregular some times and may not be poly line and may not be joined. It’s better to use the way I calculated the area using boundary command

Thanks again for your help

Andy

[Macia.Lopez]

Sorry for refreshing an old topic here but can we modify the code to somehow accommodate the TAG names which contains \U+0020 i.e. Space character ? The creator of the title block which I am using has used spaces in his TAG names 😞

[pbejse]

---

@bababarghi wrote:
Sorry for refreshing an old topic here but can we modify the code to somehow accommodate the TAG names which contains \U+0020 i.e. Space character ? The creator of the title block which I am using has used spaces in his TAG names 😞

---

Post a sample drawing. If the creator can put a space on a name TAG then surely a program can retireve it.