Change text inside blocks

Hello

knowing that is not possible to replace text

inside bloks whith the command Find

i kindly please this kind of lisp

1. select few blocks

2. activate the command -BEDIT

3. replace text BS in SQ

4.close the block -BCLOSE

for all selected blocks ( LOOP )

Thanks

Find & Replace for Blocks:

(defun c:ReplaceBlockText ( / _StringSubst old new doc ) (vl-load-com)
 ;; © Lee Mac 2011

 (defun _StringSubst ( new old str / i l ) (setq i 0 l (strlen new))
   (while
     (and
       (< i (strlen str))
       (setq i (vl-string-search old str i))
       (setq str (vl-string-subst new old str i) i (+ i l))
     )
   )
   str
 )

 (setq old (getstring t "\nFind What: "))
 (setq new (getstring t "\nReplace With: "))

 (vlax-for block
   (vla-get-blocks
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   )
   (if
     (and
       (eq :vlax-false (vla-get-isXref block))
       (eq :vlax-false (vla-get-isLayout block))
     )
     (vlax-for obj block
       (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
         (vla-put-TextString obj (_StringSubst new old (vla-get-TextString obj)))
       )
     )
   )
 )
 (vla-regen doc acActiveViewport)
 (princ)
)
         

Current Restrictions:

** Not for use on MText with formatting codes

** Wildcards not allowed

Thanks Lee for quickly replay

That 's just whot i wanted

Best Regards

Sorry for bringing an old post back to life but I have not done any programming for a long period of time and I seem to be getting old... This code works perfectly, if you want to change 1 string in a block. In my case I would need to change 2 strings in the same block.

So I figured it could be done like this:

(defun c:ReplaceBlockText ( / _StringSubst old new old1 new1 doc ) (vl-load-com)
 ;; © Lee Mac 2011

 (defun _StringSubst ( new old str / i l ) (setq i 0 l (strlen new))
   (while
     (and
       (< i (strlen str))
       (setq i (vl-string-search old str i))
       (setq str (vl-string-subst new old str i) i (+ i l))
     )
   )
   str
 )

 (setq old (getstring t "\nFind What: "))
 (setq new (getstring t "\nReplace With: "))
 (setq old1 (getstring t "\nFind another string: "))
 (setq new1 (getstring t "\nReplace With this string: "))

 (vlax-for block
   (vla-get-blocks
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   )
   (if
     (and
       (eq :vlax-false (vla-get-isXref block))
       (eq :vlax-false (vla-get-isLayout block))
     )
     (vlax-for obj block
   (progn
       (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
         (vla-put-TextString obj (_StringSubst new old (vla-get-TextString obj)))
       )
   (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
         (vla-put-TextString obj (_StringSubst new1 old1 (vla-get-TextString obj)))
       )
   );_progn
     )
   )
 )
 (vla-regen doc acActiveViewport)
 (princ)
)

But I am not sure if my solution is the best way, I noticed Acad to be "slow" when performing my action. So, if one of you, or maybe LeeMac himself, would check my modifications and tell me what I am doing right or wrong, it would be very kind.

Thanks already!

But I am not sure if my solution is the best way, I noticed Acad to be "slow" when performing my action. So, if one of you, or maybe LeeMac himself, would check my modifications and tell me what I am doing right or wrong, it would be very kind.

Your modifications are generally correct - there are some redundant expressions, for example, the vlax-for expression could be reduced to:

(vlax-for obj block
   (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
       (vla-put-textstring obj (_StringSubst new1 old1 (_StringSubst new old (vla-get-TextString obj))))
   )
)

However, this difference will not significantly impact the performance of the program.

This form of program is unlikely to be fast as the program is iterating over every object within every block definition, which could potentially be thousands of objects.

Hi Lee, thanks for the quick reply!

I understand what you mean by "redundant" and "not significant impact". And also that every block is being processed and that is causing the delay. And I have maybe 250 - 500 blocks in a drawing.

But I may have a solution for my case because I want to perform this operation on 1 certain block only. And that block is only like 10 times in a drawing....

So I need to put in a filter on the block, select only blocks that are called "myblock".

But there is not coming an idea in my head where to put the filter.

I suspect this line:

(wcmatch (vla-get-objectname obj) "AcDb*Text")

should be modified with something like (assoc 2 "myblock") but this comes from the ruins in my brain from ages ago, so I would need to invest hard time. Any suggestions to put me on the right track?

Thanks

Since the block definition is being modified, this operation need only be performed once and the changes will be reflected across all references of the block in the drawing.

If only a single block is to be processed, please try the following code:

(defun c:replaceblocktext ( / blk lst old str )
   (while (not (or (= "" (setq blk (getstring t "\nSpecify block name: "))) (tblsearch "block" blk)))
       (princ (strcat "\nBlock \"" blk "\" doesn't exist."))
   )
   (if (/= "" blk)
       (progn
           (while (/= "" (setq old (getstring t "\nFind what <exit>: ")))
               (setq lst (cons (cons old (getstring t (strcat "\nReplace \"" old "\" with: "))) lst))
           )
           (if lst
               (vlax-for obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk)
                   (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
                       (progn
                           (setq str (vla-get-textstring obj))
                           (foreach itm lst (setq str (LM:stringsubst (cdr itm) (car itm) str)))
                           (vla-put-textstring obj str)
                       )
                   )
               )
           )
       )
   )
   (princ)
)

;; String Subst  -  Lee Mac
;; Substitutes a string for all occurrences of another.

(defun LM:stringsubst ( new old str / inc len )
   (setq len (strlen new)
         inc 0
   )
   (while (setq inc (vl-string-search old str inc))
       (setq str (vl-string-subst new old str inc)
             inc (+ inc len)
       )
   )
   str
)

(vl-load-com) (princ)

The above is completely untested and may contain typos!

NOTE: A Regen is required to see the changes - I removed this from the code in case the user did not wish to regen for every use of the program.

Hi Lee, there are no typos as fas as I tested it. It works good, but the code is totally different from the previous.

The variable blk can be omitted by just hardcoding it "myblockname". But the prompts are returning until .

I need no prompt, just replace 2 strings. The 2 strings I want to change are always the same, and the 2 new strings are also the same. Because you are putting all the strings (old and new) into a list, there is some difficulty for me to tear things apart.

I think the foreach function is where I need to seek. But that will do later. Thank you for the help so far.

Hi Lee, there are no typos as fas as I tested it. It works good, but the code is totally different from the previous.

Yes, I wanted to update my old 2011 code

The variable blk can be omitted by just hardcoding it "myblockname".

Yes, all of the prompts may be hardcoded, however, you will need to retain the check that the block exists (if (tblsearch "block" blk) ...), otherwise the vla-item expression will error.

But the prompts are returning until .

Yes, I enhanced the code to allow the user to replace any number of find/replace pairs, not just two - the program will continue to prompt for find & replace pairs until the user exits the prompt.

I think the foreach function is where I need to seek. But that will do later.

Correct - you could replace the lst variable with a fixed list of find/replace pairs, e.g.:

(foreach itm
  '(
       ("old string1" . "new string1")
       ("old string2" . "new string2")
       ...
       ("old stringN" . "new stringN")
   )
   ...
)

Thank you for the help so far.

You're most welcome!

Hello Lee,

I have had some time-isues but had a few moments this evening to try and find things out. Here is what I made from your code. It pretty well does what I need.

To all other who may come in a situation where you need to do the same operation as me:

Change text inside block

- not attribute

- one or more text objects can be change

- performed "hard coded" so no prompts for you

I will put this in a starup routine just to be sure that every drawing we send will have the correct adress in the our titleblock. We have various projects and most of them contain the wrong titleblock. So from now on each ttleblock will be processed upon opening the drawing, no one will notice.

Thanks Lee for the great help!

(defun c:rbt (/ dwg lst str)

; create your set of strings to be replaced:
 (setq
   lst    '(
     ("First string of OLD text" . "First string of NEW text")
     ("2nd string of OLD text" . "2nd string of NEW text")
     ("3rd string of OLD text" . "3rd string of NEW text")
     ("4rth string of OLD text" . "4rth string of NEW text")
      ;_carry on as you need
    )
 )
 (if lst
   (vlax-for obj
         (vla-item    (vla-get-blocks
             (vla-get-activedocument (vlax-get-acad-object))
           )
           "MyBlockname";_like "MyTitleBlockName"
         )
     (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
   (progn
     (setq str (vla-get-textstring obj))
     (foreach itm lst
       (setq str (LM:stringsubst (cdr itm) (car itm) str))
     )
     (vla-put-textstring obj str)
   )
     )
   )
 )

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

 (vla-Regen dwg acAllViewports)
 (princ)
) ;_defun

;; String Subst  -  Lee Mac
;; Substitutes a string for all occurrences of another.

(defun LM:stringsubst (new old str / inc len)
 (setq    len (strlen new)
   inc 0
 )
 (while (setq inc (vl-string-search old str inc))
   (setq str (vl-string-subst new old str inc)
     inc (+ inc len)
   )
 )
 str
)

(vl-load-com)
(princ)

There is a little bug in here, if there is not a block called "MyTitleblockName" it will return:

Command: RBT
; error: Automation Error. Key not found
Command:

If it is going to give me trouble I might considering to change this.

If the lines do not exist but the block does, there is no error returned.

I wanted to ask you, since you are very skilled programmer in LISP, and I see you are doing this for some years now, have you started doing other languages as well? Like .NET? Just curious, noting more.

Thanks Lee for the great help!

You're most welcome Pietari!

There is a little bug in here, if there is not a block called "MyTitleblockName" it will return:

 

Command: RBT
; error: Automation Error. Key not found
Command:

 

If it is going to give me trouble I might considering to change this.

Yes, all of the prompts may be hardcoded, however, you will need to retain the check that the block exists (if (tblsearch "block" blk) ...), otherwise the vla-item expression will error.

Hi Lee, yes of course, you had already mentioned it. I have made an if function (if tblsearch returns not NIL) and then wrapped the setq and next if function into it. So now it will do only if the block is present. But I discovered there is one titleblock but it can have 2 names... #%$. I'll figure something ot, I think maybe with passing arguments... If I have the time I will investigate. It was fun to be doing this :-)

But I discovered there is one titleblock but it can have 2 names... #%$. I'll figure something ot, I think maybe with passing arguments... If I have the time I will investigate. It was fun to be doing this :-)

In this case I would suggest the following:

([color=BLUE]defun[/color] c:rbt [color=BLUE]nil[/color]
   (rbt
      '([color=MAROON]"Block1"[/color] [color=MAROON]"Block2"[/color] [color=MAROON]"Block3"[/color])
      '(
           ([color=MAROON]"1st string of OLD text"[/color] . [color=MAROON]"1st string of NEW text"[/color])
           ([color=MAROON]"2nd string of OLD text"[/color] . [color=MAROON]"2nd string of NEW text"[/color])
           ([color=MAROON]"3rd string of OLD text"[/color] . [color=MAROON]"3rd string of NEW text"[/color])
           ([color=MAROON]"4th string of OLD text"[/color] . [color=MAROON]"4th string of NEW text"[/color])
       )
   )
)

([color=BLUE]defun[/color] rbt ( bnl rep [color=BLUE]/[/color] bkc doc str )
   ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         bkc ([color=BLUE]vla-get-blocks[/color] doc)
   )
   ([color=BLUE]foreach[/color] blk bnl
       ([color=BLUE]if[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] blk)
           ([color=BLUE]vlax-for[/color] obj ([color=BLUE]vla-item[/color] bkc blk)
               ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text"[/color])
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] str ([color=BLUE]vla-get-textstring[/color] obj))
                       ([color=BLUE]foreach[/color] itm rep ([color=BLUE]setq[/color] str (LM:stringsubst ([color=BLUE]cdr[/color] itm) ([color=BLUE]car[/color] itm) str)))
                       ([color=BLUE]vla-put-textstring[/color] obj str)
                   )
               )
           )
       )
   )
   ([color=BLUE]vla-regen[/color] doc [color=BLUE]acallviewports[/color])
   ([color=BLUE]princ[/color])
)

[color=GREEN];; String Subst  -  Lee Mac[/color]
[color=GREEN];; Substitutes a string for all occurrences of another.[/color]

([color=BLUE]defun[/color] LM:stringsubst ( new old str [color=BLUE]/[/color] inc len )
   ([color=BLUE]setq[/color] len ([color=BLUE]strlen[/color] new)
         inc 0
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]vl-string-search[/color] old str inc))
       ([color=BLUE]setq[/color] str ([color=BLUE]vl-string-subst[/color] new old str inc)
             inc ([color=BLUE]+[/color] inc len)
       )
   )
   str
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Hey Lee, thanks a lot, this is 99% working!! I find the code much difficult but I know your code is precicely written. So my bad :-)

On a side (the last %);

Mayby you know why this happens; one of the words I need to change is "amp" to "ampère" but AutoCAD changes it to "Ampère".

I know a "&" symbol in Autocad is "&&" in lisp.... but "è"..?

Hey Lee, thanks a lot, this is 99% working!! I find the code much difficult but I know your code is precicely written. So my bad :-)

Excellent - feel free to ask if you have any questions about the code.

On a side (the last %);

Mayby you know why this happens; one of the words I need to change is "amp" to "ampère" but AutoCAD changes it to "Ampère".

I know a "&" symbol in Autocad is "&&" in lisp.... but "è"..?

Try using:

("amp" . "amp\\U+00E8re")

Hi Lee,

Just to let you know; that works 100%.

When I have time I shall investigate the code and ask for help if needed.

TOo bad my time is lacking.

Thanks a lot !

Just to let you know; that works 100%.

When I have time I shall investigate the code and ask for help if needed.

TOo bad my time is lacking.

 

Thanks a lot !

Fantastic to hear Pietari - I'm glad all is working well.

If you have any questions about the code, feel free to ask.

Lee