求拷贝物体使两物体中心点重合的程序？
各位好：现比如说有两组图元，多个同心圆或圆弧，和一个距形，我想让它们的中心重合，圆的中心就是圆，距形的中心就是对角线交点，然后选择欲复制的图元，确认，然后再选择目的图元，这样，第一选择的图元就和第二选择的图元中心重合，第一选择的图元还在原处，只是复制，选择时最好是框选，因为工作中经常会做到这样的动作，所以请大家帮帮忙，谢谢大家！
本帖最后由 Andyhon 于 2011-7-13 12:01 编辑
;;; For test only ...
(Defun C:test ()
(princ "\框选同心圆或圆弧: ")
(setq ss1 (ssget '((0 . "ARC,CIRCLE")))
po (cdr (assoc 10 (entget (ssname ss1 0))))
)
(princ "\选矩形框: ")
(setq ss2 (ssget ":S:E" '((0 . "LWPOLYLINE")))
e2 (ssname ss2 0)
dat (entget e2)
dat (member (assoc 10 dat) dat)
pt1 (cdar dat)
dat (nth 8 dat)
pt2 (cdr dat)
Pt5 (mapcar (function (lambda (a b) (/ (+ a b) 2)))pt1 pt2)
)
;; (command "Move" ss1 "" "none" po "none" Pt5)
(command "Copy" ss1 "" "none" po "none" Pt5) ; 依 zhynt 的提示订正
)
本帖最后由 zhynt 于 2011-7-13 11:32 编辑
我做了一些修改，应该比较符合题意。
;;; For test only ...
(Defun C:test ()
(princ "\框选同心圆或圆弧: ")
(setq ss1 (ssget '((0 . "ARC,CIRCLE"))))
(command "copy" ss1 "" "@" "@")
(setq ss1 (ssget "P"))
(setq po (cdr (assoc 10 (entget (ssname ss1 0)))))
(princ "\选矩形框: ")
(setq ss2 (ssget ":S:E" '((0 . "LWPOLYLINE")))
e2(ssname ss2 0)
dat (entget e2)
dat (member (assoc 10 dat) dat)
pt1 (cdar dat)
dat (nth 10 dat);;;不知是不是机器的问题，我这里应该是10，不是8
pt2 (cdr dat)
Pt5 (mapcar (function (lambda (a b) (/ (+ a b) 2))) pt1 pt2)
)
(setq n (sslength ss1)
m 0
)
(while (/= n m)
(setq ent (entget (ssname ss1 m)))
(setq ent (subst (cons 10 pt5) (assoc 10 ent) ent))
(entmod ent)
(setq m (1+ m))
)
;;(command "Move" ss1 "" "none" po "none" Pt5)
)
...不知是不是机器的问题，我这里应该是10，不是8 ...
您用的版次较新啦
太感谢Andyhon 和zhynt 了，昨天发的贴子，今天就得到回复了，激动~~
我用的是10的，Andyhon长老的程序提示; 错误: 参数类型错误: listp 0.0，可能是版本的问题
zhynt长老修改过的程序正是我想要的，还有就是还想大胆的提点要求，呵呵~~就是框选同心圆或圆弧时，能否改成任何图元的中心，包括同心圆或圆弧，距形，多边形等，这样就完美了，多谢！！！ 不錯的程式!!
先簽到
页:
[1]