请求完善程序：N多个圆、圆弧移动到指定点(同一个圆心点)

894560869

想达到的目的：选取N多个圆、圆弧、椭圆和椭圆弧移动到指定点(最终必须是N多个圆同一个圆心点)，

省去一个个操作的麻烦

;;;圆、圆弧移动到指定点(同一个圆心点)
(defun c:QQ ()(setvar "pickbox" 24)(setvar "cmdecho" 0)
(setvar "CMDECHO" 0) 
(STRCAT "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")
(setq ss (ssget '((0 . "Arc,Circle,Ellipse"))))
         (= (sslength ss) 2))
   (progn
   (setq en (ssname ss 0) ent (entget en))
   (if (= (cdr(assoc 0 ent)) '((0 . "Arc,Circle,Ellipse")))
   (setq en1 (ssname ss 1) ent1 (entget en1))
   (setq en1 en ent1 ent en (ssname ss 1) ent (entget en))
)
   (setq pc (cdr(assoc 10 ent1))
         ptt (txtcen ent))
(setq pc  (cdr (assoc 10 ent))))

(setq pt2 (getpoint "[选择目标点] : "))
(command ".move" en "" ptt pc)
))
(setq SS nil) (setvar "cmdecho" 1))

qjchen

大概改了一下

3. ;;; 圆、圆弧移动到指定点(同一个圆心点)
4. ;;; qjchen modify
5. (defun c:qq ( / en i pc pt2 ss temp)
6.   ;(setvar "pickbox" 24)
7.   (command "undo" "be")
8.   (setvar "cmdecho" 0)
9.   (setvar "CMDECHO" 0)
10.   (prompt "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")
11.   (setq ss (ssget '((0 . "Arc,Circle,Ellipse"))))
12.   (setq pt2 (getpoint "[选择目标点] : ")) ; (= (sslength ss) 2)
13.   (setq i 0)
14.   (setq temp (getvar "osmode"))
15.   (setvar "osmode" 0)
16.   (if ss
17.     (progn
18.       (repeat (sslength ss)
19. (setq en (ssname ss i))
20. (setq pc (cdr (assoc 10 (entget en))))
21. (command ".move" en "" pc pt2)
22. (setq i (1+ i))
23.       )
24.     )
25.   )
26.   (setvar "cmdecho" 1)
27.   (setvar "osmode" temp)
28.   (command "undo" "e")
29. )

;;; 圆、圆弧移动到指定点(同一个圆心点) ;;; qjchen modify (defun c:qq ( / en i pc pt2 ss temp)   ;(setvar "pickbox" 24)   (command "undo" "be")   (setvar "cmdecho" 0)   (setvar "CMDECHO" 0)   (prompt "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")   (setq ss (ssget '((0 . "Arc,Circle,Ellipse"))))   (setq pt2 (getpoint "[选择目标点] : ")) ; (= (sslength ss) 2)   (setq i 0)   (setq temp (getvar "osmode"))   (setvar "osmode" 0)   (if ss     (progn       (repeat (sslength ss) (setq en (ssname ss i)) (setq pc (cdr (assoc 10 (entget en)))) (command ".move" en "" pc pt2) (setq i (1+ i))       )     )   )   (setvar "cmdecho" 1)   (setvar "osmode" temp)   (command "undo" "e") )

894560869

致谢qjchen

yimin0519

在已知目标“点”的情况下，用ACAD的特性(properties)【快捷键为Ctrl+1】功能也不见得比程序慢：

chenjun_nj

楼上好方法，直接在图中选点也可。

qjchen

好方法，谢2位 ：）

Andyhon

3. ;;; another choice
4. ;;; for Test only
5. (defun c:qq ( / acapp adoc pt2 vPt2)
6.    (setq acapp (vlax-get-acad-object)
7.           adoc (vla-get-activedocument acapp)
8.    )
9.   
10.    (vla-endundomark adoc)
11.    (vla-startundomark adoc)
12.    
13.    (prompt "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")
14.    (ssget '((0 . "Arc,Circle,Ellipse")))
15.    (setq pt2 (getpoint "[选择目标点] : ")
16.         vPt2 (vlax-3d-point pt2)
17.    )
18.    (vlax-for obj (vla-get-activeselectionset adoc)
19.      (vla-put-center obj vPt2)
20.    )
21.    
22.    ;; (mapcar 'vlax-release-object (list acapp adoc))
23.    
24.    (vla-endundomark adoc)
25.    (princ)
26. )

;;; another choice ;;; for Test only (defun c:qq ( / acapp adoc pt2 vPt2)    (setq acapp (vlax-get-acad-object)           adoc (vla-get-activedocument acapp)    )       (vla-endundomark adoc)    (vla-startundomark adoc)        (prompt "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")    (ssget '((0 . "Arc,Circle,Ellipse")))    (setq pt2 (getpoint "[选择目标点] : ")         vPt2 (vlax-3d-point pt2)    )    (vlax-for obj (vla-get-activeselectionset adoc)      (vla-put-center obj vPt2)    )        ;; (mapcar 'vlax-release-object (list acapp adoc))        (vla-endundomark adoc)    (princ) )

368天

谢谢楼上各位的好方法