Drawing Properties

[Anonymous]

Does anyone know where I can get my grubby paws on a lisp routine or
programme which copies or replaces the drawing properties from one drawing
to another. I'm sure I saw one somewhere and could now do with it!

TIA

CTB

[karthur1]

Yes, I will be using a script to run this on all of the drawings (Script Pro) once I get this working. Right now, it looks like I have 6 different block names, all of them have the same tag names except for one (wouldn't you know it).

I got this to work for all of the drawings except for the ones that have the blockname "T-Block". For them, the tag name is "DWG-DESCRIPTION". I need a way to get out of the first "While" loop if the block name is not found and then try to find the block "T-block" . Any suggestions?
There will also be a case where none of the block names that I have listed are present. How do I error trap this?

Here is what I have working so far.

(defun Getattval (/ title subject)
;;;Search for "Title Blocks"
(setq blk (ssget "x" '((0 . "insert") (2 . "Title-Dsz,Title-Bsz,T-BlockD,T-BlockB,DSize-TB,Bsize-TB,RTB-B,RTB-D"))))
(setq ent (ssname blk 0))
(setq name "none")
(setq name (cdr (assoc '0 (entget ent))))
(while (not (equal name "SEQEND"))
(setq LST (entget ent))
(setq attag (cdr (assoc '2 LST)))
(setq attag (strcase attag))
(if (= attag "DRAWING-DESCR-1") ;;Gets the drawing title from attribute
(setq title (CDR (assoc 1 LST)))
)
(if (= attag "DRAWING-DESCR-2") ;;Gets the drawing subject from attribute
(setq subject (CDR (assoc 1 LST)))
)
(setq ent (entnext ent))
(setq name (cdr (assoc '0 (entget ent))))
)

;;; Get the drawing summary
(setq App (vlax-Get-Acad-Object))
(setq Doc (vla-Get-ActiveDocument App))
(setq DwgProps (vla-Get-SummaryInfo Doc))
;; Now write the value to the Drawing Prop "Title" and "Subject"
(vla-Put-Title DwgProps title)
(vla-Put-Subject DwgProps subject)

(princ title) ;;prints out value
(princ subject)
(princ)
)