Lisp to Sync Attributes

[TheyCallMeJohn]

Gents,

I am looking for a lisp to sync attributes. For example block Alpha has an attribute called "LOCID" and its surrounded by blocks Beta, Charlie and Delta. All four blocks have diffrent names, attributes, and paramenters but they all have "LOCID" in common. Alpha already has a value for "LOCID" but the others do not. I would like to the lisp to sync "LOCID" for all four blocks to Alpha's value by selecting all four. Also all four may not always exist together but Alpha is always there. And there are multiple groups of Alpha & friends.

 

Does anyone have a lisp that can do this? It is way above my experience level.

[Lee Mac]

Hi,

 

Something like this? (just hacked together):

 

(defun c:SyncAtt ( / *error* _StartUndo _EndUndo doc source tag val ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

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

 (if
   (and
     (setq source
       (LM:Selectif
         (lambda ( x )
           (eq "ATTRIB" (cdr (assoc 0 (entget x))))
         )
         nentsel "\nSelect Source Attribute: "
       )
     )
     (ssget '((0 . "INSERT") (66 . 1)))
   )
   (progn
     (setq tag (cdr (assoc 2 (entget source)))
           val (cdr (assoc 1 (entget source)))
     )
     (_StartUndo doc)

     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
           (lambda ( attrib )
             (if (eq tag (vla-get-TagString attrib))
               (vla-put-TextString attrib val)
             )
           )
         )
         (vlax-invoke obj 'GetAttributes)
       )
     )
     (vla-delete ss)

     (_EndUndo doc)
   )
 )
 (princ)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - www.lee-mac.com             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo fun str / e )
 ;; © Lee Mac 2010
 (while
   (progn (setq e (car (fun str)))      
     (cond
       ( (eq 'ENAME (type e))

         (if (and foo (not (foo e)))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 e
)

 

You might also be interested in this - it could also perform your task if you use it with the 'TextString' property.

[TheyCallMeJohn]

You=Amazing. Much appreciated. You just saved me hours of work. If you are ever in SoCal, I owe you a pint or two.

[Lee Mac]

You=Amazing. Much appreciated. You just saved me hours of work. If you are ever in SoCal, I owe you a pint or two.

 

Thanks mate - happy I could help out

[TheyCallMeJohn]

Lee Mac,

What would I need to add if I wanted to temporarily change the color of the block from "Bylayer" to another color like yellow. Just so I know which objects have been completed in which haven't?

 

I tried utilizing this from afralisp but couldnt get it to work as I don't think its an available property.

 

	 (setq check (vlax-property-available-p ss "Color" T))
 (if check
	(vlax-put-property ss 'Color 4)
  );

 

I have used something like this in the past but I haven't been able to figure out how to convert the ActiveSelection to a group of enames or individual VLA-objects

 

(setq RX (vlax-vla-object->ename oBkRef))
(command "chprop" RX "" "color" "2" "")

[hanhphuc]

hi john i would use (redraw ename 3) for highlighting the entity, then command regen to normal

[TheyCallMeJohn]

So a light kind of clicked this morning and here is what I came up with...

 

(command "chprop" "p" "" "color" "3" "")

 

I changed this portion...

              (if (eq tag (vla-get-TagString attrib))
               (progn
		(vla-put-TextString attrib val)
		(command "chprop" "p" "" "color" "3" "")
	)
             )

 

To this portion...

              (if (eq tag (vla-get-TagString attrib))
               (vla-put-TextString attrib val)
             )