[LISP程序]：多重复制，复制过程中可逐步撤消！

lingzhi0512

(defun c:MC ( / en enlast n p p0 slen ss sserase yesno)
        (princ "\nSelect objects: ")
        (setq ss (ssget)
                                slen (sslength ss)
                                sserase (ssadd)
        )
        (setq p0 (getpoint "Base Point:"))
        (while (progn
                                         (initget 7 "undoX  ")
                                         (setq p (getpoint "\nundoX/Enter/<Point>:"))
                                         (cond
                                                 ((= 'list (type p))
                                                         (setq enlast (entlast))
                                                         (command "copy" ss "" p0 p)
                                                         (repeat slen
                                                                 (setq en (entnext enlast)
                                                                                         enlast en
                                                                 )
                                                                 (ssadd en sserase)
                                                         )
                                                         (setq yesno t)
                                                 )
                                                 ((= "undoX" p)
                                                          (if (/= 0 (sslength sserase))
                                                                 (progn
                                                                         (repeat slen
                                                                                 (setq n (sslength sserase))
                                                                                 (command "erase" (ssname sserase (1- n)) "")
                                                                                 (ssdel (ssname sserase (1- n)) sserase)
                                                                         )
                                                                 )
                                                                 (alert "不能再撤销了！")
                                                         )
                                                         (setq yesno t)
                                                 )
                                                 ((= "" p)
                                                         (setq yesno nil)
                                                 )
                                         )
                                 )
                (princ)
        )
)

andyhua5240

不好使，又不能右键或者是空格退出！

ycao

有参考价值。

lingzhi0512

[php]
多谢 andyhua5240 的批评指正，改进了一下，可以逐步撤消，也可以一次性取消复制了！还有什么问题各位多提意见！
command: MC
选择对象: 选择后回车
Base Point: 指定复制基点
undoX / Cancel / Enter / <Point>: 指定要复制到的点或选择参数.
undoX － 删除上一次复制的图形；
Cancel － 取消复制并删除所有已经复制的图形；
Enter － 直接回车结束复制；

(defun c:MC ()
        (princ "\nSelect objects: ")
        (setq ss (ssget)
                                slen (sslength ss)
                                index 0
        )
        (setq p0 (getpoint "Base Point:"))
        (while (progn
                                         (initget 7 "undoX Cancel  ")
                                         (setq p (getpoint "\nundoX/Cancel/Enter/<Point>:"))
                                         (cond
                                                 ((= 'list (type p))
                                                         (command "copy" ss "" p0 p)
                                                         (setq index (1+ index)
                                                                                 yesno t
                                                         )
                                                 )
                                                 ((= "undoX" p)
                                                         (if (/= 0 index)
                                                                 (progn
                                                                         (repeat slen
                                                                                 (entdel (entlast))
                                                                         )
                                                                 )
                                                                 (alert "不能再撤消了！")
                                                         )
                                                         (setq index (1- index)
                                                                                 yesno t
                                                         )
                                                 )
                                                 ((= "Cancel" p)
                                                         (repeat (* index slen)
                                                                 (entdel (entlast))
                                                         )
                                                         (setq yesno nil)
                                                 )
                                                 ((= "" p)
                                                         (setq yesno nil)
                                                 )
                                         )
                                 )
                (princ)
        )
)
[/php]

urljit

倒是给出了一个编程的思路，很好！这个程序的必要性倒是需要讨论的问题，copy m 如果undo不也可以吗，只是步子大了些

jx2008

谢谢，如果能变写出一个多步redo 的程序更好，支持搂主。