[编程交流] 将点转换为对象

(defun c:frt(/ actDoc copObj errCount extLst
              extSet fromCen layCol maxPt curLay
              minPt ObjLay okCount oLayst answ
              scLay toCen toObj vlaObj *error*)
 (vl-load-com)
 (defun *error*(msg)
   (if olaySt
     (progn
       (vla-put-Lock objLay olaySt)
       (vla-EndUndoMark actDoc)
     ); end progn
     ); end if
   (princ)
   ); end of *ERROR*
 (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
 (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
     (setq blPt(vlax-safearray->list minPt)
           trPt(vlax-safearray->list maxPt)
           cnPt(vlax-3D-point
     (list
           (+(car blPt)(/(-(car trPt)(car blPt))2))
           (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
        0.0
           ); end list
    ); end vlax-3D-point
   ); end setq
 ); end of GetBoundingCenter
 (if(not(setq extSet(ssget "_I")))
   (progn
     (princ "\n>>> Select replaced objects <<< ")
     (setq extSet(ssget))
     ); end progn
   ); end if
 (if(not extSet)
   (princ "\nReplaced objects isn't selected!")
   ); end if
 (if
   (and extSet
   (setq toObj(entsel "\n>>> Pick replacing object -> "))
   ); and and
   (progn
     (initget 1 "Yes No")
     (setq answ(getkword "\nErase replaced objects [Yes/No]: ")
    actDoc(vla-get-ActiveDocument
                   (vlax-get-Acad-object))
           layCol(vla-get-Layers actDoc)
           extLst(mapcar 'vlax-ename->vla-object
                   (vl-remove-if 'listp
                    (mapcar 'cadr(ssnamex extSet))))
           vlaObj(vlax-ename->vla-object(car toObj))
           objLay(vla-Item layCol
                    (vla-get-Layer vlaObj))
           olaySt(vla-get-Lock objLay)
           fromCen(GetBoundingCenter vlaObj)
           errCount 0
           okCount 0
        ); end setq
     (vla-StartUndoMark actDoc)
     (foreach obj extLst
  (setq toCen(GetBoundingCenter obj)
        scLay(vla-Item layCol
               (vla-get-Layer obj))
        );end setq
  (if(/= :vlax-true(vla-get-Lock scLay))
    (progn
        (setq curLay(vla-get-Layer obj))
        (vla-put-Lock objLay :vlax-false)
        (setq copObj(vla-copy vlaObj))
        (vla-Move copObj fromCen toCen)
        (vla-put-Layer copObj curLay)
        (vla-put-Lock objLay olaySt)
        (if(= "Yes" answ)
          (vla-Delete obj)
        );end if
        (setq okCount(1+ okCount))
      ); end progn
       (setq errCount(1+ errCount))
    ); end if
 ); end foreach
     (princ
 (strcat "\n" (itoa okCount) " were replaced. "
   (if(/= 0 errCount)
     (strcat (itoa errCount) " were on locked layer! ")
     ""
     ); end if
   ); end strcat
 ); end princ
     (vla-EndUndoMark actDoc)
     ); end progn
   (princ "\nReplacing object isn't selected! ")
   ); end if
 (princ)
 ); end of c:frt