Lisp to add text to all all attributes in a block

[neabailey]

I'm Looking to add an XXX to all attributes in a block. The reason is I have up to 32 empty attributes in a block. I have a way to copy text to attributes for quick redline pick ups but I need a value to pick. So I thought a lisp, lets say its named FILL, would ask to select a block to fill, and I would select and it would insert an XXX in all attributes. Once Im done with the edits, any remaining XXXs I could clear with Lisp I already have that allows me to clear out any attributes that I select.

The blocks are dynamic, but only have attributes in one view.

any ideas?

~nic

[ВeekeeCZ · Accepted solution]

Possibly like this

(vl-load-com)

(defun c:BAXXX ( / s i o)
  
  (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (repeat (setq i (sslength s))
      (foreach o (vlax-invoke (vlax-ename->vla-object (ssname s (setq i (1- i)))) 'getattributes)
	(vla-put-TextString o "XXX"))))
  (princ)
 )

[Moshe-A · Accepted solution]

@neabailey hi,

check this XXXPRO (XXX Propogate) command.

it set's the attribute to xxx only if it's empty \ null string \ not set.

enjoy

Moshe

;;; XXX PROPOGATE

(vl-load-com) ; load activex support

(defun c:xxxpro (/ is_white_space ; local function
		   adoc ss ename AcDbBlkRef AcDbAttrib text)

 ; anonymous function
 (setq is_white_space (lambda (s) (vl-every (function (lambda (n) (member n '(9 32)))) (vl-string->list s))))

		     
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc)
		     
 (if (setq ss (ssget "_:L" '((0 . "insert") (66 . 1))))
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq AcDbBlkRef (vlax-ename->vla-object ename))

   (foreach AcDbAttrib (vlax-invoke AcDbBlkRef 'GetAttributes)
    (setq text (vla-get-textString AcDbAttrib))

    (if (or (not text) (eq text "") (is_white_space text))
     (vla-put-textString AcDbAttrib "xxx")
    ); if

    (vlax-release-object AcDbAttrib)
   ); foreach

   (vlax-release-object AcDbBlkRef)
  ); foreach
 ); if

 (vla-endUndoMark adoc)
 (vlax-release-object adoc)
		     
 (princ)
); c:xxxpro

[neabailey]

Thanks! that worked!

[neabailey]

Thank you! that worked as well, I like that option to not overwrite text that is already there, Thanks again.

[neabailey]

Would there be a way to reverse this? so if editing is all done, could you make the remaining XXX attributes blank again?

[ВeekeeCZ]

You might want to try it sometimes... it is not that complicated.

(vl-load-com)

(defun c:BAXXXClear ( / s i o)
  
  (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (repeat (setq i (sslength s))
      (foreach o (vlax-invoke (vlax-ename->vla-object (ssname s (setq i (1- i)))) 'getattributes)
	(if (= (vla-get-TextString o) "XXX")
	  (vla-put-TextString o "")))))
  (princ)
  )

[Moshe-A]

@neabailey ,

here is my fix \ new prompt

Command: XXXPRO

Choose [Show/Clear] <Clear>: s

Select objects: all
5 found

choose 'show' to pop 'xxx'

choose 'clear' to remove 'xxx'

at select object you can select multiple blocks.

enjoy

Moshe

;;; XXX PROPOGATE

(vl-load-com) ; load activex support

(defun c:xxxpro (/ is_white_space _option ; local functions
		   default adoc ss ename AcDbBlkRef AcDbAttrib text)

 ; anonymous function
 (setq is_white_space (lambda (s) (vl-every (function (lambda (n) (member n '(9 32)))) (vl-string->list s))))

 (defun _option (def / ask)
  (initget "Show Clear")
  (if (not (setq ask (getkword (strcat "\nChoose [Show/Clear] <" def ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); _option


 ; here start c:xxxpro
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc)

 (if (or (eq (getvar "users1") "")
	 (null (member (getvar "users1") '("Show" "Clear")))
     )
  (setvar "users1" (setq default "Show"))
  (setq default (getvar "users1"))
 )
		     
 (if (and
       (setvar "users1" (setq opn (_option default)))
       (setq ss (ssget "_:L" '((0 . "insert") (66 . 1))))
     )
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq AcDbBlkRef (vlax-ename->vla-object ename))

   (foreach AcDbAttrib (vlax-invoke AcDbBlkRef 'GetAttributes)
    (setq text (vla-get-textString AcDbAttrib))

    (cond
     ((eq opn "Show")
      (if (or (not text) (eq text "") (is_white_space text))
       (vla-put-textString AcDbAttrib "xxx")
      ); if
     ); case
     ( t
      (if (eq (strcase text) "XXX")
       (vla-put-textString AcDbAttrib "")
      )
     ); case
    ); cond

    (vlax-release-object AcDbAttrib)
   ); foreach

   (vlax-release-object AcDbBlkRef)
  ); foreach
 ); if

 (vla-endUndoMark adoc)
 (vlax-release-object adoc)
		     
 (princ)
); c:xxxpro