hpbqqq 发表于 2016-5-17 11:37:41

求帮忙更改下程序

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

(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 发表于 2016-5-17 13:37:21

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

hpbqqq 发表于 2016-5-17 13:47:39

Linhay 发表于 2016-5-17 13:37 static/image/common/back.gif
(command "_.COPY" SS "" "0,0,0" pause "")

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

feng83 发表于 2016-5-17 19:33:43

(defun c:11 (/ os p1 p2 ss snen 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 发表于 2016-5-18 10:50:39

feng83 发表于 2016-5-17 19:33 static/image/common/back.gif
(defun c:11 (/ os p1 p2 ss snen en_old)
(setvar "cmdecho" 0)
(command ".undo" "be")


谢谢大神
页: [1]
查看完整版本: 求帮忙更改下程序