Jump to content

Recommended Posts

Posted

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

Posted

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.

Posted

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"

Posted

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.

Posted

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.

Posted

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

Posted
 
(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)
)

Posted

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.

Posted (edited)

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 by Lt Dan's legs
Updated Code
Posted

Thanks so much, that is working

Posted

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

Posted

Thanks! I should've remembered that

Posted
Thanks! I should've remembered that

 

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

 

Cheers

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...