Copy all attributes...

[DNK]

Anyone have something, or could point me to something that will copy all attribute values from one block to another, keeping in mind that the tags are the same?

 

I have the Dotsoft ToolPac which will copy selected attributes, but I need to copy ALL attributes, whether invisible or on a layer that is off/frozen, without having to select them individually. Ideally, I'd like to select the source block, then then destination block.

 

Anyone?

 

 

Thanks.

[Lee Mac]

I think this will do it:

 

http://www.cadtutor.net/forum/showthread.php?t=40266

[alanjt]

(defun c:MAV (/ AT:GetSel obj ss u aLst lkLst)
 ;; Match Attribute Values (including objects on locked layers)
 ;; Alan J. Thompson, 05.25.10

 (vl-load-com)

 (defun AT:GetSel (meth msg fnc / ent)
   ;; meth - selection method (entsel, nentsel, nentselp)
   ;; msg - message to display (nil for default)
   ;; fnc - optional function to apply to selected object
   ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
   ;; Alan J. Thompson, 05.25.10
   (setvar 'ERRNO 0)
   (while
     (progn (setq ent (meth (cond (msg)
                                  ("\nSelect object: ")
                            )
                      )
            )
            (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                  ((eq (type (car ent)) 'ENAME)
                   (if (and fnc (not (fnc ent)))
                     (princ "\nInvalid object!")
                   )
                  )
            )
     )
   )
   ent
 )

 (if (and (setq obj (car (AT:Getsel entsel
                                    "\nSelect Attributed Block: "
                                    (lambda (x / e)
                                      (and (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
                                           (eq 1 (cdr (assoc 66 e)))
                                      )
                                    )
                         )
                    )
          )
          (not (initget 0 "Yes No"))
          (setq *MAV:Choice*
                 (cond ((getkword (strcat "\nMatch ONLY selected block \""
                                          (vla-get-name (setq obj (vlax-ename->vla-object obj)))
                                          "\" [Yes/No] <"
                                          (cond (*MAV:Choice*)
                                                ((setq *MAV:Choice* "Yes"))
                                          )
                                          ">: "
                                  )
                        )
                       )
                       (*MAV:Choice*)
                 )
          )
          (setq ss (ssget (list '(0 . "INSERT")
                                '(66 . 1)
                                (cons 2
                                      (if (eq "Yes" *MAV:Choice*)
                                        (vla-get-name obj)
                                        "*"
                                      )
                                )
                          )
                   )
          )
     )
   (progn
     (setq u (not (vla-startundomark
                    (cond (*AcadDoc*)
                          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                    )
                  )
             )
     )
     (vlax-for la (vla-get-layers *AcadDoc*)
       (and (eq :vlax-true (vla-get-lock la))
            (setq lkLst (cons la lkLst))
            (vla-put-lock la :vlax-false)
       )
     )

     (foreach a (vlax-invoke obj 'GetAttributes)
       (setq aLst (cons (cons (vla-get-tagstring a) (vla-get-textstring a)) aLst))
     )

     (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
       (foreach a (vlax-invoke x 'GetAttributes)
         (if (setq att (cdr (assoc (vla-get-tagstring a) aLst)))
           (vla-put-textstring a att)
         )
       )
     )
     (vla-delete ss)

     (and lkLst (foreach l lkLst (vla-put-lock l :vlax-true)))

     (and u (vla-endundomark *AcadDoc*))
   )
 )
 (princ)
)

Edited March 2, 2011 by alanjt

[alanjt]

You could also replace the block instances with something like this...

 

http://www.theswamp.org/index.php?topic=32163.0

[alanjt]

I think this will do it:

 

http://www.cadtutor.net/forum/showthread.php?t=40266

In regards to attributed blocks, it's still on a single select basis. While it has a multiple select option, I removed blocks from that portion of the code.

[Lee Mac]

Was just the first thing I thought of - if its any consolation, I would have coded it in pretty much the same way as you did in post #3

[alanjt]

Was just the first thing I thought of - if its any consolation, I would have coded it in pretty much the same way as you did in post #3

I almost suggested it myself.

 

Thanks.

[DNK]

CLIPPED

[ATTACH]20234[/ATTACH]

 

 

Thank you. Works as described.

[alanjt]

Thank you. Works as described.

You're welcome.

[DNK]

You're welcome.

 

 

Just discovered that it'll only work if the block name is the same. Right?

 

Can you make the block name not matter but still match values of the attributes as long as the tags are the same?

[Lee Mac]

Just remove this part from the ssget filter

 

(cons 2 (vla-get-name obj))

[DNK]

Just remove this part from the ssget filter

 

(cons 2 (vla-get-name obj))

 

 

Thanks.

[qball]

Nice work Alan. I don't know what I would do without you programming guys.

[alanjt]

Nice work Alan. I don't know what I would do without you programming guys.

Anytime. I actually use this from time-to-time.

[kam1967]

Alanjt - I wanted to copying attributes from titleblockA and apply it onto titleblockB in a script fashion, where, knowing what the titleblocks' names are and incorporating that into the lisp. The lisp routine I use is called MTB.LSP (see below). In trying to use a script or use lisp so that I will not be prompted to pick the titleblocks, I think I would need a way to specify the titleblock names and have the routine update titleblockB and finish. I will use this in a script, so it's important to remove any selection option. Thank you!

 

;(princ "\nType MTB to Run")
(defun C:MTB (/)
  (setq baselist (list))      
  (setq ename (car (entsel "\nSelect Base Title Block:")))
  (while (= ename nil)
     (princ "\nNothing Picked")
     (setq ename (car (entsel "\nSelect Base Title Block:")))
  );end while
  (setq ename1 (car (entsel "\nSelect Title Block To Apply Changes:")))
  (while (= ename1 nil)
     (princ "\nNothing Picked")
     (setq ename1 (car (entsel "\nSelect Title 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) 

[BlackBox]

I wanted to copying attributes from titleblockA and apply it onto titleblockB in a script fashion, where, knowing what the titleblocks' names are ...

 

*IF* this type of task is repeatedly necessary, I would encourage you to consider using Sheet Set Manager (SSM), where the title block's attributes are populated with fields, containing the value of the SSM's Custom Properties.

 

Good luck!

[kam1967]

Yes, I understand what you mean. Thanks for the suggestion though, Renderman. I just wanted to work with the drawings that do no have fields in them at present. Maybe I'll check if my man Lee Mac can check into this. I'm sure he's got something quick and easy under his sleeves!

[alanjt]

Yes, I understand what you mean. Thanks for the suggestion though, Renderman. I just wanted to work with the drawings that do no have fields in them at present. Maybe I'll check if my man Lee Mac can check into this. I'm sure he's got something quick and easy under his sleeves!

Best of luck then.

[kam1967]

Best of luck then.

 

Sorry, alanjt - I didn't mean to offend you. If you or any programming gurus have any suggestion on how to modify this routine, I would love to hear it. Thanks in advance.

[alanjt]

Sorry, alanjt - I didn't mean to offend you. If you or any programming gurus have any suggestion on how to modify this routine, I would love to hear it. Thanks in advance.

No offense taken. ATM, I don't really have time to help.