894560869 发表于 2009-10-18 13:02:00

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

<div style="PADDING-RIGHT: 0px; MARGIN-TOP: 10px; FONT-SIZE: 12pt; OVERFLOW-X: hidden; WIDTH: 97%; WORD-BREAK: break-all; TEXT-INDENT: 0px; LINE-HEIGHT: normal; HEIGHT: 200px; WORD-WRAP: break-word;"><p>想达到的目的：选取N多个圆、圆弧移动到指定点 (必须圆、圆弧、椭圆和椭圆弧同一个圆心点),省去一个个操作的麻烦</p><p></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></div>

ZZXXQQ 发表于 2009-10-19 20:14:00


(defun c:QQ ()
(setvar "pickbox" 24)
(setvar "cmdecho" 0)
(setvar "CMDECHO" 0)
(prompt "请选取要移动的圆、圆弧、椭圆和椭圆弧 :")
(if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE"))))
(if (setq pt (getpoint "\n指定点 :")) (progn
   (setq i 0)
   (repeat (sslength ss)
    (setq en (ssname ss i)
          ent (entget en))
    (setq pc (cdr(assoc 10 ent)))
    (setq ent (subst (cons 10 pt) (assoc 10 ent) ent))
    (entmod ent)
    (setq i (1+ i))
   )
))
)
(setvar "CMDECHO" 1)
(princ)
)
页: [1]
查看完整版本: 请求完善程序：N多个圆、圆弧移动到指定点(同一个圆心点)