[编程交流] 移动多个对象半径

(defun c:radialmove ( / c ci laycoll laylst layfilt ssx i ent p entplst r )
 (vl-load-com)
 (setq c (getpoint "\nPick or specify center point for radial move : "))
 (vl-cmdf "_.circle" c "\")
 (setq ci (entlast))
 (setq laycoll (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
 (vlax-for lay laycoll
   (if (eq (vla-get-lock lay) :vlax-false)
     (setq laylst (cons (vla-get-name lay) laylst))
   )
 )
 (setq layfilt "")
 (foreach lay laylst
   (setq layfilt (strcat "," lay layfilt))
 )
 (setq layfilt (vl-string-left-trim "," layfilt))
 (setq ssx (ssget "_X" (list (cons 8 layfilt))))
 (setq i -1)
 (while (setq ent (ssname ssx (setq i (1+ i))))
   (setq p (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object ent) acextendnone))
   (if p 
     (progn
       (setq p (list (car p) (cadr p) (caddr p)))
       (setq entplst (cons (cons p ent) entplst))
     )
   )
 )
 (entdel ci)
 (vl-cmdf "_.circle" c "\")
 (setq ci (entlast))
 (setq r (cdr (assoc 40 (entget ci))))
 (foreach entp entplst
   (vl-cmdf "_.move" (cdr entp) "" (car entp) (polar c (angle c (car entp)) r))
 )
 (entdel ci)
 (princ)
)