Thanks to quite a few of you good folks here at the Swamp, I've managed to cobble these routines and would like to improve them a bit.
The first routine (UPDATEBTITLE2.lsp) simply updates or redefines the border only of our titleblock to match the current one from our network folder.
The second routine (2010_Title2.LSP) updates the attributes of that titleblock and transfers the existing values to the updated attribute block.
The first issue is in the attribute update routine.
All the values get replaced except the drawing number. I got to get this corrected but I am stumped.
Secondly, I'm trying to combine these into one routine with no success.
Any ideas or thought would be greatly appreciated. Thanks
Using Autocad2010 with Windows XP Professional
; pg2 TitleBlock Border Update
(defun c:UPDATEBTITLE2 (/ BlkDwgPath dbxApp oVer bDidError ActDoc BlkCol fromBlkCol Sel EntData BlkName fromBlkDef BlkDef fromObjList)
(vl-load-com)
(defun *error* (msg)
(if dbxApp (vlax-release-object dbxApp))
(setq dbxApp nil)
(if msg (prompt (strcat "\n Error-> " msg)))
)
(setq BlkDwgPath "BTITLE2.dwg")
(setq dbxApp
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(setq bDidError (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp BlkDwgPath))))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq BlkCol (vla-get-Blocks ActDoc))
(setq fromBlkCol (vla-get-Blocks dbxApp))
(setvar 'Errno 0)
(while
(and
(not bDidError)
(not (equal (getvar 'ErrNo) 52))
)
(if
(and
(setq EntData (entget (car Sel)))
(= (cdr (assoc 0 EntData)) "INSERT")
(setq BlkName (cdr (assoc 2 EntData)))
(not
(vl-catch-all-error-p
(setq fromBlkDef (vl-catch-all-apply 'vla-Item (list fromBlkCol BlkName)))
)
)
(setq BlkDef (vla-Item BlkCol BlkName))
)
(progn
(setq fromObjList nil)
(vlax-for obj BlkDef
(vla-Delete obj)
)
(vlax-for obj fromBlkDef
(setq fromObjList (cons obj fromObjList))
)
(vlax-invoke dbxApp 'CopyObjects fromObjList BlkDef)
(vla-Regen ActDoc acActiveViewport)
(prompt (strcat "\n Updated block: " BlkName))
)
)
)
(*error* nil)
(princ)
)
;2010_Title2.LSP 2010 Title Block Attribute Update (FOR pg 2)
(defun C:2010_Title2 (/ TXT TXXT EE E ANS ANS2 OBN SCLX SCLY OLDSNP OLDOSM oldblk oldblk1 IP)
(command "-LAYER" "SET" "BORD" "")
(setvar "cmdecho" 1)
(setvar "snapmode" 0)
(setq EE (entsel "\nSelect Base Block:"))
(if EE
(progn
(setq EE_DEL (CAR EE))
(setq EE (entget (car EE) (list "ACAD")))
(setq ANS (cdr (assoc 0 EE)))
(cond
((eq ANS "INSERT")
(setq OBN (cdr (assoc 2 EE)))
(setq SCLX (cdr (assoc 41 EE)))
(setq SCLY (cdr (assoc 42 EE)))
(setq IP (cdr (assoc 10 EE)))
(setq ANS2 (substr OBN 1 1))
(if (= ANS2 "*")
(progn
(if (= SCLX SCLY)
(princ
(strcat "\n Scale= "
(rtos SCLX 2 3)))
))
))
))
(princ " Nothing selected. "))
(command "-insert" "BTITLE2=BTITLE2.DWG" IP SCLX "" "")
(command "explode" "L")
(SETQ BASELIST (LIST))
(setq ename (entnext EE_DEL))
(setq elist (entget ename))
(command "erase" EE_DEL "" )
(setq ename1 (car (entsel "\nSelect Block To Apply Changes:")))
(while (= ename1 nil)
(princ "\nNothing Picked")
(setq ename1 (car (entsel "\nSelect Block To Apply Changes:")))
);end while
(setq ename (entnext ename))
(setq elist (entget ename)) ;the entity list of the base border
(setq etype (cdr (assoc 0 elist))) ;should be attrib
(while (= etype "ATTRIB") ;puts all the attribute in a list
(setq tag (cdr (assoc 2 elist))) ;the attribute tag
(setq val (cdr (assoc 1 elist)));the attribute value
(setq baselist (append (list (list tag val)) baselist));put the attribute in list
(setq ename (entnext ename)) ;move onto the next attribute
(setq elist (entget ename))
(setq etype (cdr (assoc 0 elist)))
);end while
(setq ename1 (entnext ename1)) ;get the next entity, should be "ATTRIB"
(setq elist1 (entget ename1)) ;the entity list of the border
(setq etype1 (cdr (assoc 0 elist1))) ;should be attrib
(while (= etype1 "ATTRIB")
(setq attval nil)
(setq tag (cdr (assoc 2 elist1)));the attribute tag
(foreach item baselist
(if (= tag (nth 0 item))
(progn
(setq attval (nth 1 item))
);end then
(progn);else do nothing go to next in list till tag matches
);end if
);end foreach
(if (/= attval nil)
(progn (setq elist1 (subst (cons 1 attval) (assoc 1 elist1) elist1))
(entmod elist1));end then
(progn);end else
);end if
(setq ename1 (entnext ename1)) ;move onto the next attribute
(setq elist1 (entget ename1))
(setq etype1 (cdr (assoc 0 elist1)))
);end while
(command "REGEN")
);end defun
(princ "\n 2010_Title2.lsp is loaded. Type \"2010_Title2\" to run. ")
(princ)