[编程交流] 替换对象（矩形）

(defun c:CTB (/ ss adoc pt_lst center blk *error* lst bpat bname bi first)
 ;;;Each primitive in a separate named block
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (setq bpat "BIS-") ;_ <- Edit block name pattern here
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (mapcar '(lambda(item)
     (setq
ss (list item)
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
)
(if (null first)
  (progn
    (setq
      bname  
     (progn
       (setq bi 0)
       (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
       bname)
      blk
     (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       bname
       )
      ) ;_ end of setq
   (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       );_ end of vla-copyobjects
    (setq first t)
  )
)
    
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
  )
  (setq
       lst     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
)
      )
     
     (mapcar 'vla-erase lst)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 )

(defun c:CTB  (/ ss mn mx insertPoint blockObj)
 (vl-load-com)
 (vla-startundomark
   (cond
     (*activeDoc*)
     ((setq *activeDoc*
             (vla-get-activedocument (vlax-get-acad-object))))))
 ;; Main code
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn
     (vlax-for x  (setq ss (vla-get-activeselectionset *activeDoc*))
       ;; Calculate the centroid
       (vla-getboundingbox x 'mn 'mx)
       (setq insertPoint
              (vlax-3d-point
                (mapcar '*
                        (mapcar '+
                                (vlax-safearray->list mn)
                                (vlax-safearray->list mx))
                        '(0.5 0.5 0.5))))
       ;; Insert block
       (setq blockObj
              (vla-insertblock
                (if (= "MODEL" (strcase (getvar 'ctab)))
                  (cond (*modelSpace*)
                        ((setq *modelSpace*
                                (vla-get-modelspace *activeDoc*))))
                  (cond (*paperSpace*)
                        ((setq *paperSpace*
                                (vla-get-paperspace *activeDoc*)))))
                insertPoint
                "[color=red]blockName[/color].dwg" [color=seagreen]; <- Include file path if not in support path[/color]
                1.
                1.
                1.
                0.))
       ;; Place block on original object's layer
       (vla-put-layer blockObj (vla-get-layer x))
       ;; Extract hyperlink and add to block
       (vlax-for link (vla-get-hyperlinks x)
         (vlax-invoke
           (vla-get-hyperlinks blockObj)
           'add
           (vla-get-url link)
           (vla-get-urldescription link)
           ""))
       ;; Delete original object
       (vla-delete x))
     ;; Delete selection set
     (vla-delete ss))
   (prompt "\n  <!>  Nothing Selected  <!> "))
 (vla-endundomark *activeDoc*)
 (princ))