958620832 发表于 2013-9-7 10:16:55

连续复制后删除原对象

(defun c:m1 ()
(setq ss (ssget))
(setq p1 (getpoint "\n请输入一个角点:"))
(setq p2 (getpoint "\n请输入另一个角点:"))
(setq pc (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)))
(initget 128 "Copy Move")
(setq yesno (getkword "\n复制(c)/移动(m):<c>"))
(if (or (= yesno "Copy") (= yesno nil)) (command "copy" ss "" "m" pc))
(if (= yesno "Move") (progn
(command "copy" ss "" "m" pc)
(command "erase" ss "")))
(princ))
为什么(command "erase" ss "")没有在程序中发挥作用？

Andyhon 发表于 2013-9-7 11:03:40

Try...
(if (= yesno "Move")
(progn
    (command "copy" ss "" "m" pc)
    (while (= 1 (getvar "cmdactive"))
      (command pause)
    )
    (command "erase" ss "")
)
)

自贡黄明儒 发表于 2013-9-7 11:06:38

(defun c:m1 ()
(setq ss (ssget))
(setq p1 (getpoint "\n请输入一个角点:"))
(setq p2 (getpoint p2 "\n请输入另一个角点:"))
(setq        pc (list (/ (+ (car p1) (car p2)) 2)
               (/ (+ (cadr p1) (cadr p2)) 2)
           )
)
(initget 128 "Copy Move")
(setq yesno (getkword "\n复制(c)/移动(m):<c>"))
(if (or (= yesno "Copy") (= yesno nil))
    (command "copy" ss "" "m" pc)
)
(if (= yesno "Move")
    (progn
      (command "copy" ss "" p1 p2)
      (command "erase" ss)
    )   
)
(princ)
)

958620832 发表于 2013-9-7 11:36:41

自贡黄明儒 发表于 2013-9-7 11:06 static/image/common/back.gif


你试过了么？成功了么？

香田里浪人 发表于 2013-9-8 13:55:18

andyhon正解。程序全文如下：
(defun c:m1 ()
(setq ss (ssget))
(setq p1 (getpoint "\n请输入一个角点:"))
(setq p2 (getpoint "\n请输入另一个角点:"))
(setq pc (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)))
(initget 128 "Copy Move")
(setq yesno (getkword "\n复制不删原对象(c)/复制后删原对象(m):<c>"))
(if (or (= yesno "Copy") (= yesno nil)) (command "copy" ss "" "m" pc))
(if (= yesno "Move")
(progn
    (command "copy" ss "" "m" pc)
    (while (= 1 (getvar "cmdactive"))
      (command pause)
    )
    (command "erase" ss "")
)
)
(princ))
页: [1]
查看完整版本: 连续复制后删除原对象