Edit Attributes with Custom Visibility

[Msspencer]

Hello,

My company has a lisp routine that was created a long time ago that works fine for most customers. The routine should search for an attribute of some name and insert the value entered. It replaces the current value without knowing the current value. Recently we began working with a new customer who has a custom property in their title block of visibility and our lisp no longer works. I don't know anything about lisp unfortunately and I am very lost. Please help.

 

Thanks,

Michael

 

 

;; CHANGE AN ATTRIBUTE
;;  INPUT TAG NAME
;;        NEW TEXT
;;  OUTPUT - Keyboard command - none
;;         - LISP command - entity name
;;
;; Description: If more than one of the same attribute
;;              tag exists, the function will change the
;;              first one found in the data base.
;;
( defun C:CHA( / tag s1 )
   ( setq tag (getstring "\nEnter Attribute Tag Name: ")
          s1 ( getstring "\nEnter New Attribute Value: ")
   );setq
   ( entupd ( cha tag s1 ))
   ( princ )
)


( defun CHA ( tag s1 / e_name SSlist SSlgth e_ cnt )
   ( setq tag ( strcase tag )) ;convert to upper case
   ( setq e_name nil )
   ( setq SSlist (ssget "X" '(( 0 . "INSERT") ( 2 . "*" )))
            SSlgth (sslength SSlist)
          e_ (entget (ssname SSlist 0))
          cnt 0
   );setq


   (while (/= cnt SSlgth)
      ;check to see if entities follow:
      (if (and (/= (dxf 66 e_) nil) (= e_name nil))
         (while (and (/= "SEQEND" (dxf 0 e_ )) ( = e_name nil ))
               ;what we are looking for
               (if (= "ATTRIB" (dxf 0 e_))
                        (if (= (dxf 2 e_ ) tag)
                           (progn
                                (setq e_name (ssname SSlist cnt ))
                                (entmod (subst ( cons 1 s1 )
                                             (assoc 1 e_ ) e_ ))
                             );progn
                          );if
                 );if
                 (setq e_ (entget (entnext (dxf -1 e_))))
           );while
       );if
      (if (= e_name nil) (setq cnt (1+ cnt)) (setq cnt SSlgth))
      (if (/= cnt SSlgth)
          (setq e_ (entget (ssname SSlist cnt ))))
       );while
       (setq SSlist nil)
        (if e_name
           ( setq e_name e_name )
      (prompt "\nAttribute TAG not 
found..\n")
   );if
);CHA 
------------------------------------------------------

[MSasu]

Can you clarify please what do you mean by custom visibility? The only new feature that I can think to is an attribute with multi-line text.

[Msspencer]

There is a Visibility Parameter in the block, the Parameter type is Visibility State. If either of the 2 choices are selected then the lisp returns "; error: bad argument type: lselsetp nil"

[MSasu]

Did you talk about a dynamic block? Sadly I didn't saw many AutoLISP solutions regarding dynamic blocks.

May be useful to post an example drawing (stripped out of any other information), maybe someone with more experience in this will have a look.

[Msspencer]

I don't know if it is a dynamic block. I am not familiar with that. I will try to post a drawing that I feel is stripped enough to be safe to post.

[Lt Dan's legs]

Hit F1 while in the Visual LISP Console for more information

 

Hopefully this helps..

 

 
(vl-load-com)
;;for Dynamic block properties
(
 (lambda ( / b )
   (if
     (and (not (prompt "\nSelect a block:"))
       (setq b (ssget "_:s" '((0 . "insert"))))
       (setq b (vlax-ename->vla-object (ssname b 0)))
     )(vlax-invoke b 'GetDynamicBlockProperties)
   )
 )
)

;;for attributes
(
 (lambda ( / b )
   (if
     (and (not (prompt "\nSelect a block:"))
       (setq b (ssget "_:s" '((0 . "insert"))))
       (setq b (vlax-ename->vla-object (ssname b 0)))
     )(vlax-invoke b 'GetAttributes)
   )
 )
)

[Lt Dan's legs]

 
(defun c:CHA ( / *error* ss->lst tag s1 ss ) (vl-load-com)

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   ) (princ)
 )
 (defun ss->lst ( ss flag / id lst )
   (if (eq 'PICKSET (type ss))
     (repeat (setq id (sslength ss))
       (
         (lambda ( name )
           (setq lst
             (cons
               (if flag (vlax-ename->vla-object name)
                 name
               )lst
             )
           )
         )(ssname ss (setq id (1- id)))
       )
     )
   )
 )
 (if 
   (and
     (setq tag (getstring "\nEnter Attribute Tag Name: "))
     (setq s1 ( getstring "\nEnter New Attribute Value: "))
     (not (prompt "\nSelect blocks to search: "))
     (setq ss (ss->lst (ssget '((0 . "insert"))) t))
   )
   (foreach x ss
     (foreach a (vlax-invoke x 'GetAttributes)
       (if 
         (wcmatch (strcase (vla-get-tagstring a))
           (strcase  tag)
         ) (vla-put-textstring a s1)
       )
     )
   )
 ) (princ)
)

[Msspencer]

That is working. One small request though. It is requiring me to select the block, I hope to use this in a script so I need to be able to either type in the block name or make it not block dependent.

[Lt Dan's legs]

I'm assuming your blocks with attributes are dynamic blocks. If not you can filter the selection by

(ssget "_x" '((0 . "insert")(2 . blockname)))

 

 
(defun c:CHA ( / *error* ss->lst tag s1 ss bn ) (vl-load-com)

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   ) (princ)
 )
 (defun ss->lst ( ss flag / id lst )
   (if (eq 'PICKSET (type ss))
     (repeat (setq id (sslength ss))
       (
         (lambda ( name )
           (setq lst
             (cons
               (if flag (vlax-ename->vla-object name)
                 name
               )lst
             )
           )
         )(ssname ss (setq id (1- id)))
       )
     )
   )
 )
 (if 
   (and
     (setq tag (getstring "\nEnter Attribute Tag Name: "))
     (setq s1 ( getstring "\nEnter New Attribute Value: "))
     (setq bn ( getstring t "\nEnter block name to search: "))
     (setq ss 
       (ss->lst 
         (ssget "_x" 
           (list (cons 0 "insert")
             (cons 66 1)
             (cons 2 (strcat bn ",`*U*"))
           )
         ) t
       )
     )
   )
   (foreach x ss
     (if 
       (eq (strcase bn)
         (strcase (vla-get-effectivename x))
       )
       (foreach a (vlax-invoke x 'GetAttributes)
         (if 
           (wcmatch (strcase (vla-get-tagstring a))
             (strcase  tag)
           ) (vla-put-textstring a s1)
         )
       )
     )
   )
 ) (princ)
)

Edited April 11, 2012 by Lt Dan's legs
Updated Code

[Msspencer]

Thanks so much, that is working

[pBe]

To reduce number of selection and include Anonymous name (DB has a tendency to do that when visibilty is changed)

Consider this:

(setq ss (ss->lst (ssget "_x" (list '(0 . "insert")[color=blue]'(66 . 1)[/color][color=blue](cons 2 (strcat bn ",`*U*"))[/color])) t))

[Lt Dan's legs]

Thanks! I should've remembered that

[pBe]

Thanks! I should've remembered that

 

Anytime Lt Dan's legs. I'm guilty of that myself at times.

 

Cheers