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
Solved! Go to Solution.
Solved by pbejse. Go to Solution.
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."
John F. Uhden
@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
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)
Can't find what you're looking for? Ask the community or share your knowledge.