I knew I shouldn't be posting at the end of a 16 hour day. I tried to fing the following lisp to post and just couldn't locate it. Now, this moning, I found it right off the bat.
This one fills out the sheet name, sheet number and total number of sheets, based on the Layout tab names. I know it works with my title block, but it wouldn't take much to tweak it to yours.....
;|Insert a title block into all PaperSpace Layout Tabs,
all at 0,0,0 & 0 deg. rotation, use attlist for filling
attribute values. attlist format:
(("tagstring" . "value")("tagstring" . "value"))
Routine will automagically input values for attributes of a
Title block that contains attributes with tagstrings of
"NO", "SHEETS" & "SHEET_NAME" by using the Tab order number
for the "NO" (sheet number), the total number of tabs minus 1 (the
Model tab) for "SHEETS" (number of sheets), and the Tab name for the
"SHEET_NAME". By including a listing in the attlist for any, or all,
of these you can overwrite what is placed there.
by Jeff Mishler, April 2004
|;
(defun title2tabs (bname attlist / lays blk newblk tag)
(setq lays (vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)))
)
(if (not (tblsearch "block" bname))
(progn
(princ "\nBlock not found, please select block: ")
(setq bname
(getfiled "Block Selection for Tab Insert" bname "dwg" 0))
)
)
(vlax-for x lays
(if (not (or (= "Model" (vla-get-name x))
(= (getvar "CTAB") (vla-get-name x)))
)
(progn
(setq blk (vla-get-block x))
(setq newblk nil)
(vlax-for ent blk
(if (and (eq (vla-get-objectname ent) "AcDbBlockReference")
(eq (vla-get-name ent) bname)
)
(setq newblk ent)
)
)
(if (not newblk)
(setq newblk (vlax-invoke-method
blk
'insertblock
(vlax-3d-point
'(0.0 0.0 0.0))
bname 1.0 1.0 1.0 0.0)
)
)
(if (= (vla-get-hasattributes newblk) :vlax-true)
(progn
(setq atts (vlax-safearray->list
(vlax-variant-value
(vla-getattributes newblk))))
(foreach att atts
(setq tag (vla-get-tagstring att))
(cond ((= tag "NO")
(vla-put-textstring att (itoa (vla-get-taborder x))))
((= tag "SHEETS")
(vla-put-textstring att (itoa (1- (vla-get-count lays)))))
((= tag "SHEET_NAME")
(vla-put-textstring att (strcase (stripstr (vla-get-name x) "-"))))
((assoc tag attlist)
(vla-put-textstring att (cdr (assoc tag attlist))))
(t ;no default input, add marker text
(vla-put-textstring att "????")
)
)
)
)
)
)
)
)
(princ)
)
;;following code to help facilitate creating attlist for use in title2tabs
(defun make_attlist (bname / taglist str)
(vlax-for x (vla-item (vla-get-blocks *doc*) bname)
(if (= (vla-get-objectname x) "AcDbAttributeDefinition")
(setq taglist (cons (vla-get-tagstring x) taglist))
)
)
(foreach x taglist
(setq str (getstring t (strcat "\nValue to use for attribute tag \""
x
"\": ")))
(if (not (= str ""))
(setq attlist (cons (cons x str) attlist))
)
)
attlist
)
;; or select an existing block
(defun get_attlist (/ ss obj)
(princ "\nSelect Title block to gather Attribute data from: ")
(if (setq ss (ssget ":S"'((0 . "INSERT"))))
(progn
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(if (eq :vlax-true (vla-get-hasattributes obj))
(progn
(foreach att (vlax-invoke obj "getattributes")
(setq attlist (cons (cons (vla-get-tagstring att)
(vla-get-textstring att))
attlist))
)
)
)
)
)
)
;|code to parse a string....
(setq str "wp-property")
(stripstr str "-")
returns: "property"
|;
(defun stripstr (str itm / pos)
(setq pos (vl-string-search itm str))
(if (not pos) (setq pos -1));set pos incase item looking for not found not found
;increment pos by 2, 1 for 0 vs 1 based index, 1 for next character
(substr str (+ pos 2))
);