用另一个具有属性的块替换块

REPLACE.LSP - (Block Replace) - (c) 1990 Richard D. Howard
all rights reserved - no warranty, express or implied
The included files may be used and copied for non-profit
purposes only. If you wish to include any of the files in a
commercial program, contact the author.
---------------
REPLACE, replaces selected blocks with a specified block,
retaining all of the original properties. REPLACE handles blocks
with attribute data correctly, and can optionally allow entry of
new attributes at runtime. This makes REPLACE ideal for updating
blocks whose definition has changed (AutoCAD does not updates the
attributes in such instances). When replacing attributes, REPLACE
actually erases the old block and substitutes the new one
retaining as much of the former data as possible. The two fields
that are definately modified are "entity name", and "handle
number" (because the block really is new). If you require these
to remain the same, don't use REPLACE. If no attributes are
present, REPLACE simply updates the name attached to the original
block insert. This retains ALL the inserts data, including the
entity name and handle.

(defun c:attsync2 (/ _name _gettatts _lst atts e name ss)
  (defun _lst (ss / e n out)
    (setq n -1)
    (if        (= (type ss) 'pickset)
      (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
    )
  )
  (defun _attpositions (block / att result)
    (foreach att (vlax-invoke block 'getattributes)
      (setq result (cons (list (vla-get-handle att)
                               (vlax-get att 'insertionpoint)
                               (vlax-get att 'textalignmentpoint)
                         )
                         result
                   )
      )
    )
  )
  (defun _name (b)
    (cond ((vlax-property-available-p b 'effectivename) (vla-get-effectivename b))
          ((vlax-property-available-p b 'name) (vla-get-name b))
    )
  )
  (if (and (setq e (car (entsel "\nSelect block to sync: ")))
           (setq name (_name (vlax-ename->vla-object e)))
           (setq ss (ssget "_x" (list (cons 0 "insert"))))
      )
    (progn (foreach x (_lst ss) (and (eq (_name x) name) (setq atts (cons (_attpositions x) atts))))
           (command "._attsync" "_s" e "_yes")
           (foreach x (apply 'append atts)
             (if (and (setq e (handent (car x))) (setq e (vlax-ename->vla-object e)))
               (progn (vl-catch-all-apply 'vlax-put (list e 'insertionpoint (cadr x)))
                      (vl-catch-all-apply 'vlax-put (list e 'textalignmentpoint (caddr x)))
               )
             )
           )
    )
  )
  (princ)
)