[求助]CAD 多重复制 如何用一个命令按扭完成！！

xuyigu

以前在2000I中有这样一个按扭，多重复制只要点一下按扭就可完成，现用2002、2004等软件都没这个按扭，而要手工输入M，多重复制 如何用一个命令按扭完成！请告之，不胜感谢！

citykunan

存成*.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 "")

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

meflying

还真没发现系统有这个功能啊，害得我还自己开发了一个supercopy，现在一看，原来跟多重复制一模一样。

你可以自己做个菜单，自动输入M，就象那个在同一点break命令一样，依葫芦画瓢就可以了

xuyigu

楼上的，如何做这个自动输入M，我做了一个，只能用于选一个对象，用框选就不行了，请赐教！！

meflying

to citykunan :写程序不用这么长吧，我记得我的程序还不到10行代码。

^C^C_copy \\ _m这样可以有一次框选

BDYCAD

多重COPY以在COPY的指令里, 加以正確運用可以得到很好的較果. 但並用寫得那樣長的一條程序吧. 樓上的方法是很直接和實用. 呵呵. 但我很少用這個功能.



---------------------------------------------------
I love　ＣＡＤ　．　共同交流共同進步.

东哥

xuyigu

你们说得对，这个方法我也在用，只是只能选一次，另写长程序的朋友，你给的我试了，功能可以，只是结束时必须用ESC，，用右键还是继续复制啊！！

xuyigu

你们说得对，这个方法我也在用，只是只能选一次，另写长程序的朋友，你给的我试了，功能可以，只是结束时必须用ESC，，用右键还是继续复制啊！！

meflying

试试下面这个程序，右键退出，不过没有拖动效果，如果你们需要，我可以做一下
(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)
)