AutoLisp Routine Needed

I have tried to figure out an AutoLisp routine to update block attribute information but I have become utterly frustrated so I am asking for some help if someone is bored and would like to take a crack at this one.

I have a wiring diagram in which I have created several blocks as connector contact blocks that have two attributes first is TAG "RDN1" value "AcDbBlockReference" and the second is TAG "RDN2" value "AcDbBlockReference". I use these attributes to link the connector conatct blocks attributes with a starting connector block attribute TAG "RDN" value set by user and an ending connector block attribute TAG "RDN" value set by user. This way if the starting or ending connector RDN value is changed my connector contact block attributes change with it.

Right now I have to use ATTEDIT, double click the "AcDbBlockReference" field, select the object type, then select RDN from the list of properties.

I would like to automate this so I would not have to go thru the ATTEDIT process and instead just select the connector contact, then select starting connector block and then select ending connector block and these attributes would be changed.

Any help would be greatly appreciated.

I am not sure but I think I have done something similar where you pick a block or text to get the unique id of another block and then change values with in that block automatically.

Could you paste a dwg may clarify

BIGAL....Thanks for the reply. The smallest size I can get the dwg to is 900kb so I can't post it here. My email is t_shadle@yahoo.com if you send me an email I'll reply to you with the file.

Thanks,

Follow up to the original post. I have found a couple of lisp routines on this forum that copies a block's attributes to an external .txt file. Then another lisp routine that reads the .txt file and inserts the attribute value into any block with the same attribute TAG. This is part of what I was originally looking for, however the attributes I wish to change are AcDbBlockReference fields. When I use the above lisp routines it replaces the AcDbBlockReference with a text string therefore removing the AcDbBlockReference linking.

Is there a way to use lisp to update a field without overwriting it as a text string?

Sorry I got excited when the above lisp routines worked that I forgot to get the author's name....but mega props it worked as advertised and will come in very handy for other applications. You guys & gals rock !!!

Sorry,

I may be misunderstanding this request, but, do you want to select a block and the value of attribute TAG "RDN" will be put into an attribute as a field of another block?

That is exactly what I was looking for. (your version is more simplified)

But the block receiving "RDN" value would have to remain linked so when the block with TAG "RDN" value is changed, all of the blocks linked to it will change with it.

I hope this isn't too confusing?

Thanks for the reply...I am mentally exhausted trying to decifer dozens of autolisp routines I've found over the last few days. With no more knowledge than how to make a lisp that says "hi" my brain is a pool of autolisp mush.

If I understand correctly, give this a shot:

(defun c:Contact (/ *error* lst2str SourceTag DestTagLst ent1 eLst1 att1 ent2 eLst2 att2 uFlag)
 (vl-load-com)
 ;; Lee Mac  ~  04.02.10

 (setq SourceTag "RDN" DestTagLst '("RDN1" "RDN2"))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))                 

 (defun lst2str (lst sep)
   (if (cdr lst)
     (strcat (car lst) sep (lst2str (cdr lst) sep))
     (car lst)))

 (while
   (progn
     (setq ent1 (nentsel (strcat "\nSelect Block or Attrib to get " SourceTag ": ")))

     (cond (  (eq 'ENAME (type (car ent1)))

              (if (or (and (eq "ATTRIB"  (cdr (assoc 0 (setq eLst1 (entget (car ent1))))))
                           (eq SourceTag (strcase (cdr (assoc 2 eLst1))))
                           (setq att1 (vlax-ename->vla-object (car ent1))))
                      
                      (and (= 4 (length ent1))
                           (eq "INSERT" (cdr (assoc 0 (entget (setq ent1 (car (last ent1)))))))
                           (progn
                             (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq ent1 (entnext ent1)))))))
                               (if (eq SourceTag (cdr (assoc 2 (entget ent1))))
                                 (setq att1 (vlax-ename->vla-object ent1))))
                             
                             att1)))
                (while
                  (progn
                    (setq ent2 (car (nentsel (strcat "\nSelect Destination Attrib for " SourceTag ": "))))

                    (cond (  (eq 'ENAME (type ent2))

                             (if (eq "ATTRIB" (cdr (assoc 0 (setq eLst2 (entget ent2)))))
                               
                               (if (vl-position (cdr (assoc 2 eLst2)) DestTagLst)
                                 (progn
                                   (setq uFlag (not (vla-StartUndoMark *doc)))
                                   
                                   (vla-put-TextString
                                     (setq att2 (vlax-ename->vla-object ent2))
                                       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                         (itoa
                                           (vla-get-ObjectId att1)) ">%).TextString>%"))

                                    (vla-update att2)
                                    (setq uFlag (vla-EndUndoMark *doc)))

                                 (princ (strcat "\n** ATTRIB Must be Either " (lst2str DestTagLst ",") " **")))

                               (princ "\n** Object Must be an ATTRIB **"))))))
                
                (princ (strcat "\n** Object Must be an INSERT or ATTRIB with Tag \"" SourceTag "\" **")))))))

 (vla-regen *doc acActiveViewport)
 (princ))
                                   
                                 
                  

                  
                      

                       

Lee Mac....IT WORKS!

Anyway to make it work when the RDN1 RDN2 visibility is set to OFF?

Lee Mac....IT WORKS!

 

Anyway to make it work when the RDN1 RDN2 visibility is set to OFF?

Yeah, I could make it work for that - but how would it know whether to put the value of RDN in RDN1 or RDN2? Or will they both contain the value from the same block?

Also, are we dealing with a dynamic block here?

If there is a simple way to quiz the user to put RDN into RDN1 or RDN2 that would be cool. Because the user selects the attribute I can make RDN1 and RDN2 visible but on a layer that doesn't print.

But at this moment I'm very happy.....THANKS!

sorry....yes...block is dynamic. So if needed i can make the RDN1 RDN2 attribute property invisible or use the dynamic visbility parameter so they don't show up in the model space.

A bit overkill, but hows this?

(defun c:Contact (/ *error* lst2str dcl_write ATT1 ATT2 DCTAG DESTTAGLST ELST1
                           ELST2 ENT1 ENT2 OFILE PTR SOURCETAG TAG TLST UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  04.02.10

 (setq SourceTag "RDN" DestTagLst '("RDN1" "RDN2"))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (and ofile (close ofile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))                 

 (defun lst2str (lst sep)
   (if (cdr lst)
     (strcat (car lst) sep (lst2str (cdr lst) sep))
     (car lst)))

 (defun dcl_write (fname / wPath ofile)    
   (if (not (findfile fname))      
     (if (setq wPath (findfile "ACAD.PAT"))
       (progn
         (setq wPath (vl-filename-directory wPath))
         
         (or (eq "\\" (substr wPath (strlen wPath)))
             (setq wPath (strcat wPath "\\")))
         
         (setq ofile (open (strcat wPath fname) "w"))          
         (foreach str '("fldtag : dialog { label = \"Choose Tag\";"
                        "spacer; : list_box { key = \"tags\"; }"
                        "spacer;  ok_cancel; }")            
           (write-line str ofile))          
         (setq ofile (close ofile)) t) nil) t))

 (while
   (progn
     (setq ent1 (nentsel (strcat "\nSelect Block or Attrib to get " SourceTag ": ")))

     (cond (  (eq 'ENAME (type (car ent1)))

              (if (or (and (eq "ATTRIB"  (cdr (assoc 0 (setq eLst1 (entget (car ent1))))))
                           (eq SourceTag (strcase (cdr (assoc 2 eLst1))))
                           (setq att1 (vlax-ename->vla-object (car ent1))))
                      
                      (and (= 4 (length ent1))
                           (eq "INSERT" (cdr (assoc 0 (entget (setq ent1 (car (last ent1)))))))
                           (= 1 (cdr (assoc 66 (entget ent1))))
                           (progn
                             (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq ent1 (entnext ent1)))))))
                               (if (eq SourceTag (strcase (cdr (assoc 2 (entget ent1)))))
                                 (setq att1 (vlax-ename->vla-object ent1))))
                             
                             att1)))
                (while
                  (progn
                    (setq ent2 (nentsel (strcat "\nSelect Destination Attrib for " SourceTag ": ")))

                    (cond (  (eq 'ENAME (type (car ent2)))

                             (if (or (and (eq "ATTRIB" (cdr (assoc 0 (setq eLst2 (entget (car ent2))))))
                                          (vl-position (strcase (cdr (assoc 2 eLst2))) DestTagLst)
                                          (setq att2 (vlax-ename->vla-object (car ent2))))

                                     (and (= 4 (length ent2))
                                          (eq "INSERT" (cdr (assoc 0 (entget (setq ent2 (car (last ent2)))))))
                                          (= 1 (cdr (assoc 66 (entget ent2))))
                                          (progn
                                            (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq ent2 (entnext ent2)))))))
                                              (if (vl-position (setq tag (strcase (cdr (assoc 2 (entget ent2))))) DestTagLst)
                                                (setq tLst (cons (cons tag ent2) tLst))))

                                            (if tLst
                                              (if (< 1 (length tLst))
                                                (if (dcl_write "LMAC_Contact.dcl")
                                                  (cond (  (<= (setq dcTag (load_dialog "LMAC_Contact.dcl")) 0)
                                                           (princ "\n** Error Loading Dialog **"))
                                                        (  (not (new_dialog "fldtag" dcTag))
                                                           (princ "\n** Error Loading Dialog **"))
                                                        (t
                                                           (setq ptr "0")                                                          
                                                           (start_list "tags")
                                                           (mapcar (function add_list)
                                                                   (mapcar (function car) tLst))
                                                           (end_list)

                                                           (action_tile "tags"   "(setq ptr $value)")
                                                           (action_tile "accept" "(done_dialog)")
                                                           (action_tile "cancel" "(setq ptr nil) (done_dialog)")

                                                           (start_dialog)
                                                           (unload_dialog dcTag)

                                                           (if ptr
                                                             (setq att2 (vlax-ename->vla-object
                                                                          (cdr (nth (read ptr) tLst))))))))
                                                
                                                (setq att2 (vlax-ename->vla-object (cdar tLst))))
                                              
                                              (princ (strcat "\n** ATTRIB Must be Either " (lst2str DestTagLst ",") " **")))

                                            (setq tLst nil)

                                            att2)))                                                         

                                 (progn
                                   (setq uFlag (not (vla-StartUndoMark *doc)))
                                   
                                   (vla-put-TextString att2
                                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                       (itoa
                                         (vla-get-ObjectId att1)) ">%).TextString>%"))

                                    (vla-update att2)
                                    (setq uFlag (vla-EndUndoMark *doc)))

                               (princ "\n** Object Must be an INSERT or ATTRIB **"))))))
                
                (princ (strcat "\n** Object Must be an INSERT or ATTRIB with Tag \"" SourceTag "\" **")))))))

 (vla-regen *doc acActiveViewport)
 (princ))

OK...that is awsome!!!!! That is the one. I owe you a few pints. (along with many others offered....CHEERS!)

OK...that is awsome!!!!! That is the one. I owe you a few pints. (along with many others offered....CHEERS!)

You're welcome, I enjoyed writing it