Delete all text from block lisp

[ibanez_222]

I am trying to clean up drawings and I am trying to right a lisp to delete all text from a block. I am new to lisp and and I can't figure out how to just select all text only once I am in block editor. Any help would be appreciated. Thanks.

[pBe]

 
(defun c:DelTExt  (/ blk)
     (vl-load-com)
     (cond
           ((and
                  (setq blk (car (entsel "\nSelect Block:")))
                  (eq (cdr (assoc 0 (setq blk (entget blk))))
                      "INSERT")
                  (setq blk (cdr (assoc 2 blk)))
                  (vlax-for
                         ent
                         (vla-item
                               (vla-get-blocks
                                     (vla-get-activedocument
                                           (vlax-get-acad-object)))
                               blk)
                        (if (wcmatch
                                  (strcase
                                        (vla-get-Objectname
                                              ent))
                                  "*TEXT")
                              (vla-delete ent)
                              )
                        )
                  )
            )
           )
     (princ)
    
     )

 

Requires REGEN

[Tharwat]

Another way with multiple selection set .

 

(defun c:test (/ acdoc ss i sset nme)
 (vl-load-com)
 ;; Tharwat 22. 07. 2011
 (setq acdoc (vla-get-activedocument
               (vlax-get-acad-object)
             )
 )
 (if
   (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat
      (setq i (sslength ss))
       (setq sset (ssname ss (setq i (1- i))))
       (setq nme (cdr (assoc 2 (entget sset))))
       (vlax-for x (vla-item
                     (vla-get-blocks acdoc)
                     nme
                   )
         (if
           (eq (vla-get-objectname x) "AcDbText")
            (vla-delete x)
         )
       )
    )
    (princ)
 )
 (vla-regen
   acdoc
   acAllViewports
 )
 (princ)
)

 

Tharwat

[ibanez_222]

Is there anyway to add a regen at the end? Also I could not get the selection set to work I must be doing it wrong. Thanks for the help.

[Lee Mac]

Another way with multiple selection set .

 

Tharwat, each unique block only need be processed once. You are processing each block for every selected insert, which is massively inefficient.

[Tharwat]

Tharwat, each unique block only need be processed once. You are processing each block for every selected insert, which is massively inefficient.

 

Do you mean the use of functions *repeat* and *vlax-for* together means twice repeated ?

[Lee Mac]

Do you mean the use of functions *repeat* and *vlax-for* together means twice repeated ?

 

No, you are repeating perhaps far more than twice - you are repeating for every selected insert in the drawing, which could mean you are needlessly repeating the process 1000's of times.

 

Each block Definition only needs to be processed once, and this change is reflected throughout all block References which reference that definition.

[Tharwat]

Would this be better than the previous one .

 

(defun c:test (/ acdoc ss i sset nme Blockdefinition)
 (vl-load-com)
 ;; Tharwat 22. 07. 2011
 (setq acdoc (vla-get-activedocument
               (vlax-get-acad-object)
             )
 )
 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat
     (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (setq nme (cdr (assoc 2 (entget sset))))
      (setq Blockdefinition (vla-item (vla-get-blocks acdoc) nme))
      (if
        (and
          (eq :vlax-false (vla-get-isxref Blockdefinition))
          (eq :vlax-false (vla-get-islayout Blockdefinition))
        )
         (vlax-for x Blockdefinition
           (if
             (eq (vla-get-objectname x) "AcDbText")
              (vla-delete x)
           )
         )
      )
   )
   (princ)
 )
 (vla-regen acdoc acAllViewports)
 (princ)
)

 

Regards.

 

Tharwat

[Lee Mac]

Would this be better than the previous one .

 

No, that is doing the same thing.

 

Suggestion: Try to understand the process/algorithm rather than blindly copy/pasting code.

[irneb]

What Lee means is you're stepping through the selection set. Which may contain hundreds (if not thousands) of copies of the same block. Then for each of those copies you go and edit that same block again and again and again ... You only need to edit it once, then all the copies gets updated anyway!

 

Something like this might be a lot more efficient:

(defun c:DelText (/ ss eo blst bcol b)
 ;; Select the block references - all inserts
 (if (ssget "_:L" '((0 . "INSERT")))
   (progn
     (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
     (vlax-for eo ss
       (if (not (vl-position (vla-get-EffectiveName eo) blst)) ;Only add it if it's not already added
         (setq blst (cons (vla-get-EffectiveName eo) blst))
       )
     )
     (vla-Delete ss)
   )
 )
 ;; Step through block definitions and erase the text within
 (setq bcol (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
 (foreach ss blst ;Reusing ss variable as block name
   (setq b (vla-Item bcol ss)) ;Get block definition
   (if (and ;Omit layouts & xrefs
          (eq :vlax-false (vla-get-isxref b))
          (eq :vlax-false (vla-get-islayout b))
        )
     (vlax-for eo b ;Step through all items inside block definition
       (if (wcmatch (vla-get-ObjectName eo) "AcDbText,AcDbMText") ;Check if it's a text/mtext
         (vla-Delete eo)
       )
     )
   )
 )
 (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
 (princ)
)

The ssget is only there to get hold of the names of the blocks. Actually this would usually still be less efficient than just going through the entire block collection, especially if there's hundreds of copies of the same block references all over the drawing.

 

BTW, I'm not too certain about the OP's request. Could this also include attributes? If such is the case then you'd need to add ",AcDbAttributeDefinition" into that wcmatch chek in my code. But also you'll need to add a call to AttSync for each block name.

[Tharwat]

 

Suggestion: Try to understand the process/algorithm rather than blindly copy/pasting code.

 

Where do you think that I copied the code from ?

[Tharwat]

(defun c:test (/ acdoc ss i sset nme lst Blockdefinition)
 (vl-load-com)
 ;; Tharwat 23. 07. 2011
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq lst '())
 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat
     (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (setq nme (cdr (assoc 2 (entget sset))))
      (if (not (member nme lst))
        (progn
          (setq Blockdefinition (vla-item (vla-get-blocks acdoc) nme))
          (vlax-for x Blockdefinition
            (if (and
                  (eq :vlax-false (vla-get-isxref Blockdefinition))
                  (eq :vlax-false (vla-get-islayout Blockdefinition))
                  (eq (vla-get-objectname x) "AcDbText")
                )
              (vla-delete x)
            )
          )
          (setq lst (cons nme lst))
        )
      )
   )
   (princ)
 )
 (vla-regen acdoc acAllViewports)
 (princ)
)

[Lee Mac]

Pure Vanilla AutoLISP alternative:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a b ) [color=GREEN];; Lee Mac 2011[/color]
 ([color=BLUE]if[/color]
   ([color=BLUE]setq[/color] a
     ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S:L"[/color]
       ([color=BLUE]cons[/color] '(0 . [color=MAROON]"INSERT"[/color])
         (
           ([color=BLUE]lambda[/color] ( [color=BLUE]/[/color] a b )
             ([color=BLUE]while[/color] ([color=BLUE]setq[/color] a ([color=BLUE]tblnext[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]null[/color] a)))
               ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]logand[/color] 20 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 a))))
                 ([color=BLUE]setq[/color] b ([color=BLUE]cons[/color] [color=MAROON]","[/color] ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 a)) b)))
               )
             )
             ([color=BLUE]if[/color] b ([color=BLUE]list[/color] '(-4 . [color=MAROON]"<NOT"[/color]) ([color=BLUE]cons[/color] 2 ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]cdr[/color] b))) '(-4 . [color=MAROON]"NOT>"[/color])))
           )
         )
       )
     )
   )
   (
     ([color=BLUE]lambda[/color] ( b ) ([color=BLUE]entmake[/color] b)
       (
         ([color=BLUE]lambda[/color] ( b )
           ([color=BLUE]while[/color] b
             ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] b))) [color=MAROON]"TEXT,MTEXT"[/color]))
               ([color=BLUE]entmake[/color] ([color=BLUE]entget[/color] b))
             )
             ([color=BLUE]setq[/color] b ([color=BLUE]entnext[/color] b))
           )
           ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"ENDBLK"[/color]) ([color=BLUE]cons[/color] 8 [color=MAROON]"0"[/color])))
         )
         ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -2 b))
       )
       ([color=BLUE]command[/color] [color=MAROON]"_.regenall"[/color])
     )
     ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] a 0)))))
   )
 )
 ([color=BLUE]princ[/color])
)

[BlackBox]

This thread made me think that creating a generalized sub-function would be useful... one which accepts a Block Object (reference?) and the "AcDb*" Object(s) to be removed (either single string, or list of strings). Just a thought.

 

Edit: If others would find this helpful, I'd be happy to write (contribute) some code for this.

[Lee Mac]

This thread made me think that creating a generalized sub-function would be useful...

 

Here is a very generalised subfunction I put on my site.

[BlackBox]

Here is a very generalised subfunction I put on my site.

 

Nicely done Lee. :wink:

[Lee Mac]

Nicely done Lee. :wink:

 

Thanks Renderman

[irneb]

Lee, great to show that not everything needs those vla* functions. It's just a pity that recreating the internals of the block breaks so many of the new features (e.g. Dynamic Blocks & Associative Dims).

 

Tharwat, great! That way works nicely!

 

To the OP: Would you want this to work on nested blocks as well?

[Tharwat]

Tharwat, great! That way works nicely!

 

 

Thank you so much irneb , I am glad to know your opinion, and I did learn a lot from your nice explanations .

 

Highly appreciated.

 

Tharwat

[irneb]

Glad to help. Hope to see more great things from you soon!