Lisp to add Tag on existing Attribut

[francine.zimmermannSRSWJ]

Is it possible by Lisp to add 2 new Tags on existing Attribut, with same text style, text size & position after the existing one. (see attached example)

I found a Lisp "addattribs.lsp" on internet but the text size and position are different. How can I modify that?

Thank you very much in advance for your help

[john.uhden]

@francine.zimmermannSRSWJ ,

Reading the topic statement first, I thought you wanted to add a 2nd tag to one attribute.

To my knowledge that cannot be done.  But I hope you mean that you want to add additional attributes to a block definition.  I'm sure some talented person here has code for doing that.

OR try Googling "add-attribute AutoCAD."

[pbejse · Accepted solution]

---

@francine.zimmermannSRSWJ wrote:

I found a Lisp "addattribs.lsp" on internet but the text size and position are different. How can I modify that?

(defun c:addattribs ( / ss i blk blks def tagInfo tagprop numberOfTags tagCollection data n strs ntag  )
(setq tagInfo '("New Attribute " "NEW_TAG" "New Value ")
      tagprop '("InsertionPoint" "Height" "StyleName" "Layer" "ScaleFactor")
      numberOfTags 2)  
    (and
       (setq ss (ssget "X" '((0 . "INSERT"))))
       (setq i (sslength ss))
       (while (> i 0)
	  (setq blk (getpropertyvalue (ssname ss (setq i (1- i))) "BlockTableRecord/Name"))
          (if (not (vl-position blk blks))(setq blks (cons blk blks)))
       )
    )
    (foreach blk blks
         (setq tagCollection nil n 1
	       def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
      	 (Vlax-for itm def
	   	(and (eq (vlax-get itm 'ObjectName) "AcDbAttributeDefinition")
		  	(setq tagCollection (cons
					      (mapcar '(lambda (p)(vlax-get itm p))tagprop
						       ) tagCollection )
					      )
		     )
	   )
      (setq data (Car (vl-sort tagCollection '(lambda (a b)(< (cadar a)(cadar b)))))
      	    ipt (Car data) data (Cdr data))
      (while (<= n  numberOfTags)
		(setq strs (mapcar '(lambda (str) (strcat str (itoa n))) tagInfo
			   )
		      ntag (Vlax-invoke def 'AddAttribute (Car data) acattributemodelockposition (Car strs)
					(setq ipt (polar ipt (* pi 1.5) (* 1.5 (Car data))))
			     			(Cadr strs) (Cadr strs))
		      )
		(mapcar '(lambda (j k)(vlax-put ntag j k))
			(cdr tagprop) data )
		(Setq n (1+ n))
	)
      
         (command "_.attsync" "_N" blk)
	)
    (princ)
)
(vl-load-com) (princ)

HTH

[komondormrex]

modification to the lisp you've found

(defun c:addattribs ( / ss i blk blks def )
    (and
       (setq ss (ssget "X" '((0 . "INSERT"))))
       (setq blks (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
	   (foreach blk blks
         	(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (setq blk_name (vla-get-effectivename blk))))
         	(vla-addattribute def
         	    (getvar 'textsize)
         	    acattributemodelockposition
         	    "New Attribute 1"
         	    (vlax-3D-point 0 0)
         	    "NEW_TAG1"
         	    "New Value 1"
         	)
         	(vla-addattribute def
         	    (getvar 'textsize)
         	    acattributemodelockposition
         	    "New Attribute 2"
         	    (vlax-3D-point 0 (- (* 1.5 (getvar 'textsize))))
         	    "NEW_TAG2"
         	    "New Value 2"
         	)
         	(command "_.attsync" "_N" blk_name)
     	)
    )
    (princ)
)
(vl-load-com) (princ)