[综合讨论] 替换选定的块组...

;;  Function to copy blocks from one point to another
(defun c:Replaceblocks
                       (/      ent1   ent2   obj1   obj2   pt1
                        pt2    x      ss     index  keyw   rot
                        r2d    copyobj
                       )
  (while
    (= ent1 nil)
     (setq ent1 (car (entsel "\n Select block to copy: ")))
     (if (= ent1 nil)
       (alert "\n You missed, try again...")
     )
  )
  (while
    (= ent2 nil)
     (setq ent2 (car (entsel "\n Select block you want to swap: ")))
     (if (= ent2 nil)
       (alert "\n You missed, try again...")
     )
  )
  (setq        obj1 (vlax-ename->vla-object ent1)
        pt1  (trans (vlax-get obj1 'insertionpoint) 0 1)
  )
  (setq        obj2 (vlax-ename->vla-object ent2)
        x    (vlax-get-property obj2 'Name)
  )
  (if
    (and
      (= (vla-get-ObjectName Obj1) "AcDbBlockReference")
      (not (vlax-property-available-p Obj1 'Path))
    )
     (progn
       (if (not *default*)
         (setq *default* "Select")
       )
       (initget 0 "Select All")
       (setq keyw
              (cond
                ((getkword
                   (strcat "\nEnter selection option (Select / All): >: "
                   )
                 )
                )
                (*default*)
              )
       )
       (setq *default* keyw)
       (cond
         ((= Keyw "Select") (setq SS (ssget (list (cons '2 x)))))
         ((= Keyw "All") (setq SS (ssget "X" (list (cons '2 x)))))
       )
       (setq
         index -1
       )
       (while (vla-object obj)
               pt2     (trans (vlax-get obj2 'insertionpoint) 0 1)
               rot     (vlax-get obj2 'Rotation)
               copyobj (vlax-invoke obj1 'Copy)
         )
         (vla-put-rotation copyobj rot)
         (vlax-invoke copyobj 'Move pt1 pt2)
       )
     )
  )
  (princ)
  (command "_erase" ss "")
  (princ)
  (princ (strcat "\nBlocks swapped - " (itoa index)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:REPLs (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
 (prompt "\nSelect Replacement Block: ")
 (setq bl2 (cdr (assoc 2 (entget (car (entsel))))))
 (prompt "Select blocks to replace: ")
 (setq ENT1 (ssget))
 (setq N (sslength ENT1))
 (setq I 0)
 (repeat N
  (setq BL1 (entget (ssname ENT1 I)))
  (setq NWNM (cons 2 bl2))
  (setq OLD (assoc 2 BL1))
  (setq ODNM (cdr OLD))
  (entmod (subst NWNM OLD BL1))
  (setq I (1+ I))
 )
(command "undo" "end")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;