求帮忙更改下程序

hpbqqq

一下程序是在原有位置复制对象到当前图层，先想要功能是复制对象到当前图层，但位置由鼠标指定。

(vl-load-com)
(setvar "CMDECHO" 0)
(defun ALL-LAY (/ LAY I)
  (vlax-for I  (vla-get-layers
   (vla-get-activedocument (vlax-get-acad-object)))
    (setq LAY (cons (vla-get-name I) LAY)))
  (setq LAY (vl-sort LAY '<)))
(defun S-LAY  (/ SS I LAY)
  (setq SS (ssget))
  (setq SS (vla-get-activeselectionset
      (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for I SS (setq LAY (cons (vla-get-layer I) LAY)))
  (setq LAY (vl-sort LAY '<)))
(defun NS-LAY  (/ LAY MBR)
  (setq LAY (ALL-LAY))
  (foreach MBR (S-LAY) (setq LAY (vl-remove MBR LAY)))
  (setq LAY (vl-sort LAY '<)))
(defun C:11  (/ ss)
  (prompt "复制对象到当前层.\n")
  (setq SS (ssget))
  (command "_.COPY" SS "" "0,0,0" "0,0,0" "")
  (command "_.CHANGE" SS "" "P" "LA" (getvar "CLAYER") "")
  (princ))

Linhay

(command "_.COPY" SS "" "0,0,0" pause "")

hpbqqq

Linhay 发表于 2016-5-17 13:37
(command "_.COPY" SS "" "0,0,0" pause "")

不行的，执行命令后鼠标就捕捉原点，也移动不了 。但还是要谢谢你

feng83

(defun c:11 (/ os p1 p2 ss sn  en en_old)
  (setvar "cmdecho" 0)
  (command ".undo" "be")
  (setq os (getvar "clayer"))
  (prompt "\n复制对象到当前层")
  (setq ss (ssget) sn 0 )
  (setq p1 (getpoint "\n 指定参考点: "))
  (setq p2 (getpoint p1 "\n 指定第二点: "))
  (command "_.COPY" SS "" p1 p2)
  (command "undo" 1)
  (if (= nil ss) (setq ss (ssadd)))
  (while (< sn (sslength ss))
         (setq en (ssname ss sn))  
         (command "copy" en "" p1 p2)
         (setq en_old (entlast))
         (command "change" en_old "" "p" "layer" os "")
         (setq sn (+ 1 sn ))
         )
   (command ".undo" "e")
   (setvar "cmdecho" 1)
  (print)
)

hpbqqq

feng83 发表于 2016-5-17 19:33
(defun c:11 (/ os p1 p2 ss sn  en en_old)
  (setvar "cmdecho" 0)
  (command ".undo" "be")

谢谢大神