I'm trying to write some code to be able to take a titleblock from layout tab A and place it on layouts B, C, D, E, etc....
The titleblock has atributes so I've included my trusty attribute read write sub-routines.
All I really want to do is copy the titleblock on the first layout directly to the other layouts, with out any changes to the attributes.
The main code I'm working on is (defun C:TC ().........
Thanks for any help,
Rabbit
;;;------------------------------------------------------------------------------------------------
;;;Thanks to J. Roper for this section:
;;---------------------------------------------------------
;ATT:GETS - Utility routine to get all attributes for
;an insert object (EN).
;;
;;You pass this function an entity name, like something that would be returned from this example:
;;(setq EN (car (entsel "\nSelect block")))
;;an entity name looks like this when returned on a command line --><Entity name: 4119ab90>
;;You use this function like this: (setq ATTLIST (ATT:GETS EN))
;;it returns a list like this ---> (("TAG1 . "VALUE1")("TAG2" . "VALUE2")....)
(defun ATT:GETS (EN / EL RES)
;entnext goes on to the next entity. If what you passed is an attributed block, the next entity will be an attribute.
(setq EN (entnext EN)
EL (entget EN));entget "breaks open" the entity name to reveal the entity list
(while (= "ATTRIB" (cdr (assoc 0 EL)));we check the entity list to see if it is an attribute
(setq RES (cons
(cons (cdr (assoc 2 EL));if it is, we create a list of its tag and value, dxf code 2 and 1, using CONS
(cdr (assoc 1 EL))) RES)
EN (entnext EN);go to the next entity
EL (entget EN)));get the next entities list
(reverse RES);reverse the list to put it in proper order.
)
;;This is the compliment to ATT:GETS. It puts stuff back in a block
;;---------------------------------------------------------
;ATT:REPLACE - Replace attributes in entity (EN)
;from the list (ATTS). The list can be a sequential
;list of strings to be replaced or a list containing
;tag names and attribute values to be replaced specifically.
;
(defun ATT:REPLACE (EN ATTS / EN1 EL)
(setq EN1 EN)
(if (atom (car ATTS)) ;;is first list element an atom?
;;update sequential
(foreach ATT ATTS
(setq EN (entnext EN) ;;get the next entity
EL (entget EN) ;;it is an attribute
EL (subst (cons 1 ATT) ;;substitute the value
(assoc 1 EL) EL)
)
(entmod EL) ;;update it in the drawing database
)
;;else update by tag names
(while (= "ATTRIB" (cdr (assoc 0 (setq EL (entget (setq EN (entnext EN)))))))
(if (assoc (cdr (assoc 2 EL)) ATTS)
(entmod (subst (cons 1 (cdr ;;use CDR if dotted pairs, CADR for non-dotted
(assoc (cdr (assoc 2 EL)) ATTS)))
(assoc 1 EL) EL)
)
)
)
)
;;
;; Regenerate the block insert and attributes.
;;
(entupd EN1)
)
(defun delatom (a l / tmp)
(while l
(if (not (equal a (car l) 1e-11))
(setq tmp (cons (car l) tmp)))
(setq l (cdr l)))
(reverse tmp))
;;;main code starts here - this is what I'm trying to figure out
(defun c:TC ()
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq ActiveDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq Space (vla-get-paperspace ActiveDocument))
(setq TBlock (cdr (assoc 331 (entget (vlax-vla-object->ename (vla-item (vla-get-blocks ActiveDocument) "prb2436a"))))))
(setq AttributeInfo (ATT:GETS TBlock));get attribute value
(setq LayList (layoutlist))
(setq LayList (delatom "K1" LayList)
(setq LayoutObjects (vla-get-layouts ActiveDocument))
(repeat (length LayList)
(setq count 0)
(vla-insertblock (get_item (nth count LayList) LayoutObjects) (vlax-3d-point 2.78388 1.10378 0.0) "prb2436a" 1.0 1.0 1.0 0)
(ATT:REPLACE (entlast) (list (cons TEMATTTag TEMNewAttribute)))
;;;gotta finish the code in here
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
