[求助]CAD 多重复制 如何用一个命令按扭完成！！
以前在2000I中有这样一个按扭，多重复制只要点一下按扭就可完成，现用2002、2004等软件都没这个按扭，而要手工输入M，多重复制 如何用一个命令按扭完成！请告之，不胜感谢！ 存成*.lsp,加载后，在command中输入cm即可。(defun c:CM ()
;**** Internal error handler defined locally ****
(defun DR_ERR (S) ; If an error (such as CTRL-C) occurs
(if (/= S "Function cancelled") ; while this command is active...
(if (= S "quit / exit abort")
(princ)
(princ (strcat "\nError: " S))
);end if
);end if
(if DR_OER ;If an old error routine exists
(setq *error* DR_OER) ;then, reset it
);end if
(if (not BASEPT) ;if an initial displacement was used
(foreach x SSELIST (redraw X 4));unhighlight the last selection set
)
(setvar "cmdecho" 1) ;reset command echo upon error
(princ)
);end error defun
;**** Set our new error handler ****
(if (not *DEBUG*)
(if *error*
(setq DR_OER *error* *error* DR_ERR)
(setq *error* DR_ERR)
);end if
);end if
;**** BEGIN MAIN FUNCTION ****
(if (setq EMARK (entlast))
(while (setq B (entnext EMARK))
(setq EMARK B)
)
)
(setq SS (ssget))
(setvar "cmdecho" 0)
(prompt "\nBase point or Displacement: ")
(command "copy" SS "" pause)
(setq BASEPT (getvar "lastpoint"))
(prompt "\nCopy point: ")
(command pause)
(if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
(progn (setq REFPT LASTPT)
(setq BASEPT nil)
)
)
(if BASEPT
(while (entnext EMARK) ;while there are new entities
(setq SSOLD SS)
(setq SS (ssadd)) ;reset SS
(while (entnext EMARK) ;while there are new entities
(setq EMARK (entnext EMARK))
(ssadd EMARK SS) ;add them to new SS
)
(if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
(progn (command "erase" SS "")
(command "copy" SSOLD "" REFPT "")
(setvar "lastpoint" (polar BASEPT ANGLPT DISTPT))
)
(progn (setq ANGLPT (angle BASEPT LASTPT))
(setq DISTPT (distance BASEPT LASTPT))
(setq REFPT (polar '(0.0 0.0 0.0) ANGLPT DISTPT))
(setq BASEPT LASTPT) ;increment basepoint
(prompt (strcat "\nCopy point <@" (rtos (car REFPT)) "," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: "))
(command "copy" SS "" BASEPT pause)
)
)
);end while
(while (entnext EMARK) ;while there are new entities
(setq SSOLD SS)
(setq SS (ssadd)) ;reset SS
(while (entnext EMARK) ;while there are new entities
(setq EMARK (entnext EMARK))
(redraw EMARK 3)
(if SSELIST
(setq SSELIST (append (list EMARK) SSELIST))
(setq SSELIST (list EMARK))
)
(ssadd EMARK SS) ;add them to new SS
)
(ssget "P")
(setq REFPT (getpoint (strcat "\nDisplacement <" (rtos (car REFPT)) "," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: ")))
(if (not REFPT)
(setq REFPT (getvar "lastpoint"))
)
(command "copy" SS "" REFPT "")
);end while
);end if
(setvar "cmdecho" 1)
(princ)
);end defun
(princ) 还真没发现系统有这个功能啊，害得我还自己开发了一个supercopy，现在一看，原来跟多重复制一模一样。
你可以自己做个菜单，自动输入M，就象那个在同一点break命令一样，依葫芦画瓢就可以了 楼上的，如何做这个自动输入M，我做了一个，只能用于选一个对象，用框选就不行了，请赐教！！ to citykunan :写程序不用这么长吧，我记得我的程序还不到10行代码。
^C^C_copy \\ _m这样可以有一次框选 多重COPY以在COPY的指令里, 加以正確運用可以得到很好的較果. 但並用寫得那樣長的一條程序吧. 樓上的方法是很直接和實用. 呵呵. 但我很少用這個功能.
---------------------------------------------------
I love ＣＡＤ ． 共同交流共同進步. 你们说得对，这个方法我也在用，只是只能选一次，另写长程序的朋友，你给的我试了，功能可以，只是结束时必须用ESC，，用右键还是继续复制啊！！ 你们说得对，这个方法我也在用，只是只能选一次，另写长程序的朋友，你给的我试了，功能可以，只是结束时必须用ESC，，用右键还是继续复制啊！！ 试试下面这个程序，右键退出，不过没有拖动效果，如果你们需要，我可以做一下
(defun c:Scopy( / ss pt pt2)
(setvar "cmdecho" 0)
(setq ss (ssget))
(setq pt (getpoint "\n选择基点:"))
(setq pt2 (getpoint pt "\n选择插入点:"))
(while pt2
(command "_.copy" ss "" pt pt2)
(setq pt2 (getpoint pt "\n选择插入点:"))
)
(princ)
)