Delete all text from block lisp

[Lee Mac]

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

 

Indeed, though it was interesting to code all the same

 

I do find many look for a Visual LISP method before considering what can be accomplished using Vanilla AutoLISP, its sometimes refreshing to go another route.

[BlackBox]

I do find many look for a Visual LISP method before considering what can be accomplished using Vanilla AutoLISP

 

I found this to be true...

 

 

Chapter 2 - Basic Coding in Visual LISP

 

...

...

 

While the differences between how you might traditionally access the layer name using DXF entity access is only slight, the user does not need to know that DXF field 8 is the layer assignment. They can instead use (vla-get-layer) which is a bit more intuitive. This is the crux of what makes the ActiveX features in VLISP attractive: clarity.

 

its sometimes refreshing to go another route.

 

1+ --> That is why I've started to teach myself (and writing basic commands in) .NET, especially given that I use a vertical platform (Civil 3D)... as discussed elsewhere, many AEC* objects cannot be accessed via vlax-dump-object in C3D, let alone object manipulation.

[ibanez_222]

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?

 

I guess it would be nice if it did nested blocks also. I do like yours the best irneb, because it lets me do a selection set or individual. I didn't play with everybodies yet though. I don't know much about lisp yet, I am just starting to learn just CAD in general, so I wouldn't know if one was more efficient than the other. I guess if it is editing the same block over and over again I can see how that would be inefficient, but not sure how it really matters. Thanks everone for the help.

[Lee Mac]

I guess it would be nice if it did nested blocks also. I do like yours the best irneb, because it lets me do a selection set or individual.

 

Just to clarify: when selecting the block references, the programs aren't modifying only those in the selection, by altering the block definitions they are modifying ALL references of those selected blocks throughout the drawing. Should you want to modify an individual reference of a specific block definition, you would need to recreate/copy the block definition, then make your modifications.

[ibanez_222]

Yeah I think I know what you mean. My problem was that I had a lot of blocks in the drawings that were different, and clicking them individually was taking a while, but with the selection it I could get all of them at once. I know it would be changing multiples of the same block, but in my case I'm just cleaning up a bunch of clutter in a drawing for Electrical design purposes so most of the block information is useless to me besides the basic outline.

[irneb]

You're welcome. Here's a mod which should handle nested blocks as well:

(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)))
       ss   0
 )
 (while (< ss (length blst))
   (setq b  (vla-Item bcol (nth ss blst)) ;Get block definition
         ss (1+ ss)
   )
   (if (and ;Omit layouts & xrefs dependent blocks
         (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
       (cond
         ((wcmatch (vla-get-ObjectName eo) "AcDbText,AcDbMText") ;Check if it's a text/mtext
          (vla-Delete eo)
         )
         ((and (wcmatch (vla-get-ObjectName eo) "AcDbBlockReference") ;If it's a block, and
               (not (vl-position (vla-get-EffectiveName eo) blst)) ;Not already added to list to be changed
          )
          (setq blst (append blst (list (vla-get-EffectiveName eo)))) ;Append its name to end of list
         )
       )
     )
   )
 )
 (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
 (princ)
)

[ibanez_222]

Thank you, Not sure which one we are going to end up using, if we want it to delete nested blocks or not but at least we have the option. Thanks again.

[K Baden]

I keep getting a Too Few arguments error with this code. This thread is pretty similar. I am trying to get any blocks on the TOWER layer and change the text within to the defpoints layer. I would also like to add that this changes the color to bylayer as well for the text/mtext. Any ideas why this isnt working?

 

(defun c:txtchg (/ s doc)
 (if (setq s (ssget "X" '((0 . "INSERT") (8 . "TOWER"))))
   (progn
     (vlax-for obj (vla-item (vla-get-blocks
                               (setq doc (vla-get-activedocument
                                           (vlax-get-acad-object)
                                           )
                                     )
                               )
                             (vla-get-effectivename
                               (vlax-ename->vla-object (ssname s 0))
                               )
                             )
       (if (and
             (= "AcDbMText" (vla-get-objectname obj))
              (null (vl-catch-all-error-p)
                      (vl-catch-all-apply 'vla-put-layer "Defpoints")
                    )
              )
             )
         )
       )
     )
 (vla-regen doc acallviewports)
 (princ)
 )(vl-load-com)

[Tharwat]

(vl-catch-all-apply 'vla-put-layer (list obj "Defpoints"))

[K Baden]

Made that change, still getting a weird error. will put updated code and error message:

 

(defun c:txtchg (/ s doc)
 (if (setq s (ssget "X" '((0 . "INSERT") (8 . "TOWER"))))
   (progn
     (vlax-for obj (vla-item (vla-get-blocks
                               (setq doc (vla-get-activedocument
                                           (vlax-get-acad-object)
                                           )
                                     )
                               )
                             (vla-get-effectivename
                               (vlax-ename->vla-object (ssname s 0))
                               )
                             )
       (if (and
             (= "AcDbMText" (vla-get-objectname obj))
              (null (vl-catch-all-error-p)
                      (vl-catch-all-apply 'vla-put-layer (list obj "Defpoints"))
                    )
              )
             )
         )
       )
     )
 (vla-regen doc acallviewports)
 (princ)
 )(vl-load-com)

 

ERROR message:

Command: too few arguments: (IF (AND (= "AcDbMText" (vla-get-ObjectName OBJ)) (NULL (VL-CATCH-ALL-ERROR-P) (VL-CATCH-ALL-APPLY (QUOTE vla-put-Layer) (LIST OBJ "Defpoints")))))
Command:

[Tharwat]

See the changes below:

 

Made that change, still getting a weird error. will put updated code and error message:

 

       (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-layer (list obj "Defpoints")) )
       

[K Baden]

hmmm. No idea why im still getting a syntax error with this. looking at the Visual LISP editor within autocad, a check on the code is still giving me this error, in reference to this piece of the code:

 

; error: too few arguments: (IF (AND ( ... ) ( ... )))

 

(if (and
             (= "AcDbMText" (vla-get-objectname obj))
              (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-layer (list obj "Defpoints")) )
                    )
              )
             )

[Tharwat]

(defun c:txtchg (/ s doc)
 (if (setq doc (vla-get-activedocument (vlax-get-acad-object))
           s   (ssget "_X" '((0 . "INSERT") (8 . "TOWER")))
     )
   (progn
     (vla-add (vla-get-layers doc) "Defpoints")
     (vlax-for obj (vla-item (vla-get-blocks doc) (vla-get-effectivename (vlax-ename->vla-object (ssname s 0))))
       (if (= "AcDbMText" (vla-get-objectname obj))
         (vl-catch-all-apply 'vla-put-layer (list obj "Defpoints"))
       )
     )
     (vla-regen doc acallviewports)
   )
 )
 (princ)
) (vl-load-com)

[K Baden]

Perfect!! Thank you so much for the help!

[Tharwat]

Perfect!! Thank you so much for the help!

 

You're welcome.

[K Baden]

Trying to perhaps expand on it a tad and this is my attempt. I am still learning! Is this giving me "Too many arguments" because i have them all set as "obj" and not different? or will i need to do as you did and get the colors and linetypes as you did for the layers?

 

(defun c:twrblkpropchg (/ s doc)
 (if (setq doc (vla-get-activedocument (vlax-get-acad-object))
           s   (ssget "_X" '((0 . "INSERT") (8 . "TOWER")))
     )
   (progn
     (vla-add (vla-get-layers doc) "0")
     (vlax-for obj (vla-item (vla-get-blocks doc) (vla-get-effectivename (vlax-ename->vla-object (ssname s 0))))
       (if (= "AcDbLine" (vla-get-objectname obj))
    (= "AcDbCircle" (vla-get-objectname obj))
    (= "AcDbArc" (vla-get-objectname obj))
    (= "AcDbPolyline" (vla-get-objectname obj))
         (vl-catch-all-apply 'vla-put-layer (list obj "0"))
         (vl-catch-all-apply 'vla-put-color (list obj "ByBlock"))
         (vl-catch-all-apply 'vla-put-linetype (list obj "ByBlock"))
       )
     )
     (vla-regen doc acallviewports)
   )
 )
 (princ)
) (vl-load-com)

[Grrr]

K Baden,

You are providing the if function with too many arguments, heres simple correction of what you were trying to achieve:

 

(if 
 (or 
   (= "AcDbLine" (vla-get-objectname obj))
   (= "AcDbCircle" (vla-get-objectname obj))
   (= "AcDbArc" (vla-get-objectname obj))
   (= "AcDbPolyline" (vla-get-objectname obj))
 )
 (progn
   (vl-catch-all-apply 'vla-put-layer (list obj "0"))
   (vl-catch-all-apply 'vla-put-color (list obj "ByBlock"))
   (vl-catch-all-apply 'vla-put-linetype (list obj "ByBlock"))
 )
)

 

Ofcourse it could be written a bit more effectively (and perhaps more confusing to you).

 

Read this carefully, to learn about conditionals in LISP.

I think thats the most basic task for any programming language.

[Lee Mac]

This is a classic case of masking an unknown error using a vl-catch-all-apply expression, making the code horrendous to debug.

 

The ActiveX color property is integer-valued not string-valued, but the code masks the exception thrown when attempting to assign a string value to this property, and so the user is led to believe the property change is successful.

 

I know I've said it before, but I would strongly advise using vl-catch-all-apply expressions sparingly, and only when deemed absolutely necessary. I always visualise the use of such expressions as a 'sledgehammer' approach: try something, if it fails, clear up the mess afterwards.

 

Here is an alternative to consider:

(defun c:twrblkpropchg ( / blc blk doc idx lst sel )
   (if (setq sel (ssget "_X" '((0 . "INSERT") (8 . "TOWER"))))
       (progn
           (setq doc (vla-get-activedocument (vlax-get-acad-object))
                 blc (vla-get-blocks doc)
           )
           (repeat (setq idx (sslength sel))
               (setq idx (1- idx)
                     blk (vla-get-effectivename (vlax-ename->vla-object (ssname sel idx)))
               )
               (if (not (member blk lst))
                   (progn
                       (vlax-for obj (vla-item blc blk)
                           (if (and (wcmatch (vla-get-objectname obj) "AcDbLine,AcDbCircle,AcDbArc,AcDbPolyline") (vlax-write-enabled-p obj))
                               (progn
                                   (vla-put-layer obj "0")
                                   (vla-put-color obj acbyblock)
                                   (vla-put-linetype obj "ByBlock")
                               )
                           )
                       )
                       (setq lst (cons blk lst))
                   )
               )
           )
           (vla-regen doc acallviewports)
       )
   )
   (princ)
)
(vl-load-com) (princ)

[K Baden]

This is perfect. Thank you both for all the help. and for the advice!! Always taking notes to learn more. Thanks again!

[Grrr]

I appreciate Lee's reminder-oppinion about the vl-catch-all-apply error-trapping techique.

Indeed using it that way, without the help of conditionals and prompts for the possible occurring errors, while the routine is running - the debbuging part becames harder and in larger codes nearly impossible,

since one must trace every evaluation thru his head.

Just leaving my 0.02$ on this.

 

The intention of my previous post was only to help out with the condiitionals, and no attention to the other problem(s).