Topic: Copy attribute values from titleblocks

[hyposmurf]

Ive used the blockreplace command before but found it produces unpredictable results when blocks contain attributes.Anyone know where to get a lisp that will copy the attribute values from one block to another.For instance I have one titleblock inserted with the title, name, date etc already filled out.What Id like to do is copy the contents to another empty titleblock.The titleblock wont look identical but will have the same attribute data.This would be handy when an engineer decides he wants his drawing to appear on diffferent size layouts or when changes are made to the original titleblock.Am I right in thinking youd need a lisp that will extract the data like the ATTEXT command.

[MikePerry]

Hi

Take a look at the Express Tools commands -

AttOut
AttIn

Have a good one, Mike

[ronjonp]

Also take a look at gatte (global attribute edit) in express tools.

[CADaver]

Also look into ATTSYNC after redefining the block.

[Kate M]

You should be all right as long as the attribute tags are identical for the two blocks...if they're different you can end up with some values erased.

[whdjr]

Ive used the blockreplace command before but found it produces unpredictable results when blocks contain attributes.Anyone know where to get a lisp that will copy the attribute values from one block to another.For instance I have one titleblock inserted with the title, name, date etc already filled out.What Id like to do is copy the contents to another empty titleblock.The titleblock wont look identical but will have the same attribute data.This would be handy when an engineer decides he wants his drawing to appear on diffferent size layouts or when changes are made to the original titleblock.Am I right in thinking youd need a lisp that will extract the data like the ATTEXT command.

Blockreplace works well for an entire file.  Then you have to sync up the new block from the old block.  Use BATTMAN, its in the expresstools.  We run our finish schedule and door schedule like this in A2K, so let me know if you have any more questions or need some code.

[hyposmurf]

many ways to skin a cat Thanks .Im going to go and try them.I was half way there with the ATTOUT command .That ATTIN & ATTOUT does what I need and so does Keith's MODATT tool that he devised a while back.Im going to now have a look at the other options

[Darryl]

Here's something else you might try.  I've been using a LISP program that I wrote approx. 10 years ago.  We use it whenever we update title blocks or need to insert a new title block due to a different drawing size, etc.  Our title blocks have about 2 dozen attributes which I copy and then update some attributes to current info.  I've included a shortened version of it here - with only 8 attributes, and deleted the update section.  Maybe this is something you can modify with your attribute tags or add others as needed.

Code: [Select]

;=========================================================================
; COPYTB.LSP ver. 1.0   by Darryl Filbrun   1-26-05
;
; PURPOSE: To copy the data from one title block to another.
;
;==========================================================================

(defun c:copydata (/ e1 ee1 a1 aa1 e2)
;=========================================
; Get data from first title block
;=========================================
   (setq SSET (car (entsel "\nSelect Title Block to Copy Data FROM...")))
;------------ File Name
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "FILE-NAME" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-FILE-NAME (cdr (assoc 1 A1)))
;------------ Drawing Number
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DWG-NO" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-DWG-NO (cdr (assoc 1 A1)))
;------------ Title
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "TITLE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-TITLE (cdr (assoc 1 A1)))

;------------ Designed
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DESIGNED" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-DESIGNED (cdr (assoc 1 A1)))
;------------ Drawn By
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DRAWN" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-DRAWN (cdr (assoc 1 A1)))
;----------- Date Drawn
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DRN-DATE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-DRN-DATE (cdr (assoc 1 A1)))
;------------ Scale
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "SCALE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-SCALE (cdr (assoc 1 A1)))
;------------ Checked
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "CHECKED" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq FROM-CHECKED (cdr (assoc 1 A1)))
;=========================================
; Copy data to second title block
;=========================================
   (setq SSET (car (entsel "\nSelect Title Block to Copy Data TO...")))
;------------ File Name
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "FILE-NAME" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-FILE-NAME)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Drawing Number
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DWG-NO" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-DWG-NO)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Title
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "TITLE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-TITLE)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Designed
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DESIGNED" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-DESIGNED)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Drawn By
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DRAWN" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-DRAWN)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Date Drawn
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "DRN-DATE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-DRN-DATE)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Scale
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "SCALE" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-SCALE)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;------------ Checked By
   (setq E1 SSET
         EE1 E1
         AA1 "xxxx"
   )
   (while (/= "CHECKED" AA1)
      (setq E2 (entnext EE1)
            EE1 E2
      )
      (setq A1 (entget E2))
      (setq AA1 (cdr (assoc 2 A1)))
   )
   (setq A1 (subst (cons 1 FROM-CHECKED)
                   (assoc 1 A1)
                   A1
            )
   )
   (entmod A1)
;====================================================================
   (entupd E1) ;Update screen to show new info.
) ;Close defun c:copydata
;====================================================================

(defun c:copytb (/ ER)
   (setvar "cmdecho" 0)
   (princ "\n        CopyTB.LSP ver. 1.0   by Darryl Filbrun   1-26-05")
   (setq ER *error*)
   (defun *error* (msg)
      (setq *error* er)
      (princ msg)
      (princ)
   )
   (c:copydata)
   (prin1)
)
;====================================================================


If you would like my complete current LISP file, I'll be glad to e-mail it to you.  Hope this helps.

P.S.  Another useful program that I've also been wanting to write is one that would copy all like-named attributes from one block to another.  It would make a list of the attributes in the "copy-from" block and another list of those in the "copy-to" block, then compare them and copy only those having the same attribute tag.  But I'm not real good at writing LISP - often copying parts of other code and experimenting until I get it to work.  I expect someone else could write it real quickly.  Any ideas or suggestions?  I notice that Mark Thomas wrote MST-attribute_list, which would probably be a good start, but I don't know anything about VBA.

[hyposmurf]

This more in the direction I was thinking of thanks.

[Biscuits]

This lisp routine will match the block attributes values from one
block by matching attribute tags and then the values.
Once installed type "MB" to run.

;;   matchblocks.lsp
;;
;;
(princ "\nType MB to Run")
(defun C:MB (/)
   (setq baselist (list))      
   (setq ename (car (entsel "\nSelect Base Block:")))
   (while (= ename nil)
      (princ "\nNothing Picked")
      (setq ename (car (entsel "\nSelect Base Block:")))
   );end while
   (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)

[Darryl]

Thanks a lot Bisquits!  I tried your LISP and like it.  That's what I was wanting to write, but I'm sure it's much more concise than I could have done.  Hyposmurf ought to be able to use this too -  and it's much shorter than the one I posted.

Have a great day!

[ELOQUINTET]

i use the matchblocks routine but have always thought it would be a major improvement to add a dcl that would have a copy from column and a copy to  check box to copy or not. also a copy all box would be cool i suppose. you wouldn't want all of the blocks to have the same page number or revision info. i think you get me drift. i'd love to write something like this but don't know enough about this to go about it yet. anyone up for the challenge???