894560869 发表于 2009-10-18 12:59:00

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

<p></p><p>想达到的目的：选取N多个圆、圆弧、椭圆和椭圆弧移动到指定点(最终必须是N多个圆同一个圆心点)，</p><p>省去一个个操作的麻烦<br/></p><p>;;;圆、圆弧移动到指定点(同一个圆心点)<br/>(defun c:QQ ()(setvar "pickbox" 24)(setvar "cmdecho" 0) <br/>(setvar "CMDECHO" 0)&nbsp; <br/>(STRCAT "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")<br/>(setq ss (ssget '((0 . "Arc,Circle,Ellipse"))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (= (sslength ss) 2)) <br/>&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp; (setq en (ssname ss 0) ent (entget en))<br/>&nbsp;&nbsp; (if (= (cdr(assoc 0 ent)) '((0 . "Arc,Circle,Ellipse")))<br/>&nbsp;&nbsp; (setq en1 (ssname ss 1) ent1 (entget en1))<br/>&nbsp;&nbsp; (setq en1 en ent1 ent en (ssname ss 1) ent (entget en))<br/>)<br/>&nbsp;&nbsp; (setq pc (cdr(assoc 10 ent1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ptt (txtcen ent)) <br/>(setq pc&nbsp; (cdr (assoc 10 ent))))</p><p>(setq pt2 (getpoint "[选择目标点] : "))<br/>(command ".move" en "" ptt pc)<br/>))<br/>(setq SS nil) (setvar "cmdecho" 1)) </p>

qjchen 发表于 2009-10-18 19:40:00

大概改了一下

;;; 圆、圆弧移动到指定点(同一个圆心点)
;;; 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 发表于 2009-10-19 07:39:00

<font color="#f70909">致谢qjchen</font>

yimin0519 发表于 2009-10-19 08:15:00

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

chenjun_nj 发表于 2009-10-19 13:14:00

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

qjchen 发表于 2009-10-19 22:16:00

<p>好方法，谢2位 ：）</p>

Andyhon 发表于 2009-10-28 11:33:00


;;; 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天 发表于 2009-11-4 16:56:00

<p>谢谢楼上各位的好方法</p>
页: [1]
查看完整版本: 请求完善程序：N多个圆、圆弧移动到指定点(同一个圆心点)