Redefining a block with a change in tag names: values lost

December 9, 2009

I have a block that I want to redefine. The old block did not get individually defined tag names so I am redefining the tag names; problem is that I lose my entered values. Is there a lisp routine that would save and refresh these entered values. There are hundreds of drawings with this old block so to retype everything is overwelming.

What I have done so far is:

(1) Created the new block with all tags individually named

(2) Saved the block with the same name as the old block

(3) Inserted the new block and said yes to redefining the old block

(4) did an "attsync" to bring all the new attribute tag names out to speed.

(5) **********this is where I lose all the previous values******

Does someone know of a lisp that would store those values first and re-instate them after the "attsync" is complete. The prompt remains constant from the old to the new block so that may be something in common that can be used in the storing process.

Thanks guys...love this site

December 9, 2009

Not sure if this helps?

(defun c:BlkRep (/ *error* nlk doc spc blk i ss uflag ent nObj aLst att tag)
 (vl-load-com)

 (setq nblk "C:\\...dwg")   ;; Filepath of New Block to Insert

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))   

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       
       spc (if (zerop (vla-get-activespace doc))              
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 

 (while
   (progn
     (setq blk (getstring t "\nSpecify Block Name to Replace: "))

     (cond (  (eq "" blk) nil)

           (  (not (setq i -1 ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk)))))

              (princ "\n** Block not Found in Drawing **")))))

 (if ss
   (progn
     (setq uflag (not (vla-StartUndomark doc)))
     
     (while (setq ent (ssname ss (setq i (1+ i))))

       (setq nObj
         (vla-Insertblock spc
           (vla-get-InsertionPoint
             (setq Obj (vlax-ename->vla-object ent))) nblk
           (vla-get-Xscalefactor obj)
             (vla-get-yScalefactor obj)
               (vla-get-zscalefactor obj)
                 (vla-get-Rotation obj)))

       (setq aLst
         (mapcar
           (function
             (lambda (x)
               (cons (strcase (vla-get-TagString x)) (vla-get-TextString x))))
           (vlax-invoke Obj 'GetAttributes)))

       (foreach att (vlax-invoke nObj 'GetAttributes)
         (if (setq tag (assoc (strcase (vla-get-TagString att)) aLst))
           (vla-put-TextString att (cdr tag))))

       (entdel ent))

     (setq uflag (vla-EndUndoMark doc))))

 (princ))

Specify Filepath of new Block at top with double backslashes.

December 9, 2009

Not sure if this helps?

(defun c:BlkRep (/ *error* nlk doc spc blk i ss uflag ent nObj aLst att tag)
 (vl-load-com)

 (setq nblk "C:\\...dwg")   ;; Filepath of New Block to Insert

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))   

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))

       spc (if (zerop (vla-get-activespace doc))              
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))


 (while
   (progn
     (setq blk (getstring t "\nSpecify Block Name to Replace: "))

     (cond (  (eq "" blk) nil)

           (  (not (setq i -1 ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk)))))

              (princ "\n** Block not Found in Drawing **")))))

 (if ss
   (progn
     (setq uflag (not (vla-StartUndomark doc)))

     (while (setq ent (ssname ss (setq i (1+ i))))

       (setq nObj
         (vla-Insertblock spc
           (vla-get-InsertionPoint
             (setq Obj (vlax-ename->vla-object ent))) nblk
           (vla-get-Xscalefactor obj)
             (vla-get-yScalefactor obj)
               (vla-get-zscalefactor obj)
                 (vla-get-Rotation obj)))

       (setq aLst
         (mapcar
           (function
             (lambda (x)
               (cons (strcase (vla-get-TagString x)) (vla-get-TextString x))))
           (vlax-invoke Obj 'GetAttributes)))

       (foreach att (vlax-invoke nObj 'GetAttributes)
         (if (setq tag (assoc (strcase (vla-get-TagString att)) aLst))
           (vla-put-TextString att (cdr tag))))

       (entdel ent))

     (setq uflag (vla-EndUndoMark doc))))

 (princ))

Specify Filepath of new Block at top with double backslashes.

Mac, it works slicker than snot !!

December 9, 2009

Mac, it works slicker than snot !!

Haha that's one way to put it...

December 10, 2009

Thanks for the quick response Lee Mac ..ok it's not working for me yet. Two things are happening. First, I get an error saying Duplicate definition of block...ignored and secondly if I change the incoming block to a new block name it seems to go through with no errors, but the block disappears or is deleted from the page after completion.

Thanks

December 16, 2009

Ok...not sure if anyone is still reading this post or needs a solution for this, but after further reasearch it looks like I need to use VBA to search for PromptString and reference that to the tagstring name change: So I am challenging all VBA writers to help as I am only up on lisp, not VBA.

Attribute Tag Example (1):

Tag: -

Prompt: REV 1 DRAWN BY

Default:

Attribute Tag Example (2):

Tag: -

Prompt: REV 1 DATE

Default:

Example (1) and Example (2) are tags that show up in the same block called "title_block"

VBA needs to search for prompt: REV 1 DATE and change the tag name associated with that prompt from - to REV-1-DATE

VBA needs to search for prompt: REV 1 DRAWN BY and change the tag name associated with that prompt from - to REV-1-DRAWN-BY

Thanks all

December 16, 2009

Ok...not sure if anyone is still reading this post or needs a solution for this, but after further reasearch it looks like I need to use VBA to search for PromptString and reference that to the tagstring name change: So I am challenging all VBA writers to help as I am only up on lisp, not VBA.

Attribute Tag Example (1):

Tag: -

Prompt: REV 1 DRAWN BY

Default:

Attribute Tag Example (2):

Tag: -

Prompt: REV 1 DATE

Default:

Example (1) and Example (2) are tags that show up in the same block called "title_block"

VBA needs to search for prompt: REV 1 DATE and change the tag name associated with that prompt from - to REV-1-DATE

VBA needs to search for prompt: REV 1 DRAWN BY and change the tag name associated with that prompt from - to REV-1-DRAWN-BY

Thanks all

I have one that was written many moons ago, just changed

prompt list

Of course, I can't test it without your bad block

Give that a try

(defun C:CTP(/)
(defun change-tags-by-prompts (/ adoc att bname ent find obj prompts)

 (setq	adoc (vla-get-activedocument
       (vlax-get-acad-object)
     )

 )
 (setq prompts '("REV 1 DRAWN BY"
	  "REV 1 DATE")
)

 (setq ent (car (entsel "\n	***	Select block to change tags: ")))
 (if ent
   (progn
     (setq obj (vlax-ename->vla-object ent))

     (if (eq :vlax-false (vla-get-isdynamicblock obj))
     (setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)

     (vlax-for	att (vla-item (vla-get-blocks adoc) bname)
(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
  (if (setq find (member (vla-get-promptstring att) prompts))
      (vla-put-tagstring att (strcase (car find)))
    )
)
     )
     (setvar "cmdecho" 0)
     (command "._attsync" "_N" bname)
     (setvar "cmdecho" 1)
     (vlax-release-object obj)
   )
 )
 (princ)
)
(change-tags-by-prompts)
(princ)
)
 (vl-load-com)
(princ "\n   ***   Type CTP to execute   **")
(prin1)

~'J'~

December 16, 2009

Thanks for the reply.....it almosts works.

I've attached the title block file for reference. When I run CTP it changes the tag name of 2 other tags, rather than the indicated ones, also all entered values after have shifted exactly 2 spaces.

I will try to modify what you have given me as it is a great start!!!! thanks!! and will post if I come up with anything. If you have a chance can you try running it on the file I have attached. ideas???

Thanks so much.

title block.dwg

December 16, 2009

Thanks for the reply.....it almosts works.

I've attached the title block file for reference. When I run CTP it changes the tag name of 2 other tags, rather than the indicated ones, also all entered values after have shifted exactly 2 spaces.

I will try to modify what you have given me as it is a great start!!!! thanks!! and will post if I come up with anything. If you have a chance can you try running it on the file I have attached. ideas???

Thanks so much.

How about this verion

(defun change-tags-by-prompts (/ acsp adoc att atts att_info blockname
		        block_info bname cur_lst ent find ipt layer
		        new_block obj prompts rot xscale yscale zscale)

 (setq	adoc (vla-get-activedocument
       (vlax-get-acad-object)
       )
acsp (vla-get-block
       (vla-get-activelayout adoc)
       )
)

 (setq ent (car (entsel "\n	***	Select block to change tags tags: ")))
 (if ent
   (progn
     (setq obj (vlax-ename->vla-object ent))

     (if (eq :vlax-false (vla-get-isdynamicblock obj))
(setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)

     (vlax-for	att  (vla-item (vla-get-blocks adoc) bname)

(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
  (progn (setq prompts (cons (vla-get-promptstring att) prompts))
    (vla-put-tagstring att (strcase (vla-get-promptstring att)))
  )
  )

)
     (setq prompts (reverse prompts))

     (vlax-release-object obj)
     (vlax-for	layout	(vla-get-layouts adoc)
(vlax-for blk  (vla-get-block layout)
  (if (eq (vla-get-objectname blk) "AcDbBlockReference")
    (progn
    (if	(eq :vlax-false (vla-get-isdynamicblock blk))
      (setq blockname (vla-get-name blk))
      (setq blockname (vla-get-effectivename blk))
      )
    (if	(eq bname blockname)
      (progn
	(setq block_info nil)
	(setq ipt    (vla-get-insertionpoint blk)
	      layer  (vla-get-layer blk)
	      rot    (vla-get-rotation blk)
	      xscale (vla-get-xscalefactor blk)
	      yscale (vla-get-yscalefactor blk)
	      zscale (vla-get-zscalefactor blk)
	      )
	(foreach att  (vlax-invoke blk 'Getattributes)
	  (setq	att_info (cons (car prompts)
			       (vla-get-textstring att)
			       )
		)
	  (setq prompts (cdr prompts))
	  (setq block_info (cons att_info block_info))
	  )
	(setq block_info (reverse block_info))

	(setq new_block (vla-insertblock acsp ipt bname xscale yscale zscale rot))
	(vla-put-layer new_block layer)
	(setq atts (vlax-invoke new_block 'Getattributes))
	(foreach att  atts
	  (if (setq find (assoc (vla-get-tagstring att) block_info))
	    (vla-put-textstring att (cdr find)))
	    )
	  )
	)
      )
    )
  )
)
     )
   )
 (princ)
 )


(defun C:CTP(/)
(change-tags-by-prompts)
(princ) 
)


(vl-load-com)
(princ "\n   ***   Type CTP to execute   **")
(prin1)

~'J'~

December 16, 2009

That works awesome !!!!! thanks so much fixo. One thing to add...the tag name that is created is an exact duplicate of the prompt and contains spaces which attributes tag names don't like. Is there any way of specifying a tag name.......so the tag with a prompt of "REV 1 DATE" now turns into "REV_1_DATE" or even something more specifically like "R1DATE"

Cheers...

December 16, 2009

That works awesome !!!!! thanks so much fixo. One thing to add...the tag name that is created is an exact duplicate of the prompt and contains spaces which attributes tag names don't like. Is there any way of specifying a tag name.......so the tag with a prompt of "REV 1 DATE" now turns into "REV_1_DATE" or even something more specifically like "R1DATE"

Cheers...

Sorry I'm sleeping now (

c u tomorrow

~'J'~

December 16, 2009

That works awesome !!!!! thanks so much fixo. One thing to add...the tag name that is created is an exact duplicate of the prompt and contains spaces which attributes tag names don't like. Is there any way of specifying a tag name.......so the tag with a prompt of "REV 1 DATE" now turns into "REV_1_DATE" or even something more specifically like "R1DATE"

Cheers...

Ah, can't sleep

Try

(defun change-tags-by-prompts (/ acsp adoc att atts att_info blockname
		        block_info bname cur_lst ent find ipt layer
		        new_block obj prompts rot xscale yscale zscale)

 (setq	adoc (vla-get-activedocument
       (vlax-get-acad-object)
       )
acsp (vla-get-block
       (vla-get-activelayout adoc)
       )
)

 (setq ent (car (entsel "\n	***	Select block to change tags tags: ")))
 (if ent
   (progn
     (setq obj (vlax-ename->vla-object ent))

     (if (eq :vlax-false (vla-get-isdynamicblock obj))
(setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)

     (vlax-for	att  (vla-item (vla-get-blocks adoc) bname)

(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
  (progn (setq prompts (cons (strcase
	     (vl-string-translate
	       (chr 32)
	       (chr 95)
	       (vla-get-promptstring att))) prompts)
	       )
	 (vla-put-tagstring
	   att
	   (strcase
	     (vl-string-translate
	       (chr 32)
	       (chr 95)
	       (vla-get-promptstring att)))))
  )
  )

     (setq prompts (reverse prompts))

     (vlax-for	layout	(vla-get-layouts adoc)
(vlax-for blk  (vla-get-block layout)
  (if (eq (vla-get-objectname blk) "AcDbBlockReference")
    (progn
    (if	(eq :vlax-false (vla-get-isdynamicblock blk))
      (setq blockname (vla-get-name blk))
      (setq blockname (vla-get-effectivename blk))
      )
    (if	(eq bname blockname)
      (progn
	(setq block_info nil)
	(setq ipt    (vla-get-insertionpoint blk)
	      layer  (vla-get-layer blk)
	      rot    (vla-get-rotation blk)
	      xscale (vla-get-xscalefactor blk)
	      yscale (vla-get-yscalefactor blk)
	      zscale (vla-get-zscalefactor blk)
	      )
	(foreach att  (vlax-invoke blk 'Getattributes)
	  (setq	att_info (cons (car prompts)
			       (vla-get-textstring att)
			       )
		)
	  (setq prompts (cdr prompts))
	  (setq block_info (cons att_info block_info))
	  )
	(setq block_info (reverse block_info))

	(setq new_block (vla-insertblock acsp ipt bname xscale yscale zscale rot))
	(vla-delete blk)
               (vlax-release-object blk)
	(vla-put-layer new_block layer)
	(setq ats (vlax-invoke new_block 'Getattributes))
	(foreach at  ats
	  (if (setq find (assoc (vla-get-tagstring at) block_info))
	    (vla-put-textstring at (cdr find)))
	  (vla-update at)
	    )
	  )
	)
      )
    )
  )
)
     )
   )
 (princ)
 )


(defun C:CTP(/)
(change-tags-by-prompts)
(princ) 
)


(vl-load-com)
(princ "\n   ***   Type CTP to execute   **")
(prin1)

~'J'~

December 17, 2009

Ah, can't sleep

Haha, you remind me of me

December 18, 2009

:)thank you so much fixo ....it works like a charm.....I can't thank you enough....have a good one !!!!!

December 18, 2009

:)thank you so much fixo ....it works like a charm.....I can't thank you enough....have a good one !!!!!

You're welcome

Glad to help

~'J'~

Sign In

Redefining a block with a change in tag names: values lost

Recommended Posts

rarmstrong

Lee Mac

stevesfr

Lee Mac

rarmstrong

rarmstrong

fixo

rarmstrong

fixo

rarmstrong

fixo

fixo

Lee Mac

rarmstrong

fixo

Join the conversation

Tutorials

Forums

Activity