transfering values from old block to new block

Hi,

I have a old autocad drawing and they need to be updated to this new style of block.

Is there a command or a macro that would allow me to transfer values from the old block to the new block?

At the minute I am having to type them manually from the old block to the new block.

I had thought about manually editing the old block into the style of the new block. This did not seem time effective solution as in reality you have 'Block_Old1', 'Block_Old2', 'Block_Old3' etc, etc, etc.

I have attached a zip file with an acad example inside.

Hopefully some one can help or point me in the right direction,

many thanks

col

My Test Example.zip

Here's a routine I've had for some time. I did not write it and I have no idea who to give credit for it.

It will work in your case, but only if the tag names are the same in both blocks.

Simply select the old block then the new one and your attributes will match.

Hope this helps

;; 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)

thank you for the response but the blocks are name with different tags.

i would prefer to use vba too as i have some knowledge of visual basic 6 so i hope to understand the vba in autocad more so than lisp.

i will keep on trying.

thanks again for your response,

col

I have been looking into this a bit more and actually there is only two types of blocks. Old and new and reading online it is possible to change the tag names for a block. So to break it down I have to do the following

1. update block name to new block name

2. update the tag names while keeping the values the same.

a. INFO_BLOCK_ID to BLOCK_REF

b. ROOM_NUMBER to ROOM_REF

c. HEIGHT to ROOM_CEILING_HEIGHT

3. change text size and style to new style block

ideally I want the macro to update all the old blocks into the new style blocks in the drawing.

Can anyone point me in the right direction?

Many thanks,

Col

Try This

(defun ReplaceTagName (lst / blkobj lays ss)
 (setq lays (vla-get-layers
       (vla-get-activedocument (vlax-get-acad-object))
     )
ss   (ssget "x" '((0 . "INSERT") (66 . 1)))
 )
 (if ss
   (progn
     (setq ss
     (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss)))
     )
     (mapcar
'(lambda (b)
   (if (eq (vla-get-lock (vla-add lays (vla-get-layer b)))
    :vlax-false
       )
     (progn
       (mapcar
 '(lambda (a)
     (mapcar
       '(lambda (c)
  (if
     (and (eq (strcase (car c))
       (strcase (vla-get-tagstring a))
   )
   (eq (vla-get-lock
         (vla-add lays (vla-get-layer a))
       )
       :vlax-false
   )
     )
      (vla-put-tagstring a (cdr c))
  )
        )
       lst
     )
   )
 (vlax-invoke b 'getattributes)
       )
       (vlax-for blkobj (vla-item
     (vla-get-blocks
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
     (vla-get-name b)
   )
 (mapcar
    '(lambda (c)
       (if
  (and
    (vlax-property-available-p blkobj 'tagstring)
    (eq (strcase (car c))
        (strcase (vla-get-tagstring blkobj))
    )
  )
  (vla-put-tagstring blkobj (cdr c))
       )
     )
    lst
 )
       )
     )
   )
)
ss
     )
   )
 )
 (princ)
)

(replacetagname '(("INFO_BLOCK_ID" . "BLOCK_REF")))
(replacetagname '(("ROOM_NUMBER" . "ROOM_REF")))
(replacetagname '(("HEIGHT" . "ROOM_CEILING_HEIGHT")))

10 years later..

Some of us in our office seem to enrjoy the MB routine.

Would like to get this to work for a selectionset for a selection of blocks

(setq ename (car (entsel "\nSelect Base Block:"))) ; entget ..