连续复制后删除原对象

958620832

(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

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

自贡黄明儒

1. (defun c:m1 ()
   
2.   (setq ss (ssget))
   
3.   (setq p1 (getpoint "\n请输入一个角点:"))
   
4.   (setq p2 (getpoint p2 "\n请输入另一个角点:"))
   
5.   (setq        pc (list (/ (+ (car p1) (car p2)) 2)
   
6.                  (/ (+ (cadr p1) (cadr p2)) 2)
   
7.            )
   
8.   )
   
9.   (initget 128 "Copy Move")
   
10.   (setq yesno (getkword "\n复制(c)/移动(m):<c>"))
    
11.   (if (or (= yesno "Copy") (= yesno nil))
    
12.     (command "copy" ss "" "m" pc)
    
13.   )
    
14.   (if (= yesno "Move")
    
15.     (progn
    
16.       (command "copy" ss "" p1 p2)
    
17.       (command "erase" ss)
    
18.     )   
    
19.   )
    
20.   (princ)
    
21. )

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

958620832

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

你试过了么？成功了么？

香田里浪人

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))