[编程交流] Lisp以同步属性

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

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

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

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

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