发布于:2013-05-01 17:40:01
来自:建筑设计/CAD下载及教程
[复制转发]
以下程序是 复制为当前层(没有多重复制功能),希望哪位大侠帮忙修改一下啦.
(defun C:111 ()
(princ "\n 复制到当前层(copy_to_layer)")
(setvar "cmdecho" 0)
(setq c_layer (getvar "clayer")
sset (ssget)
pt1 (getpoint "\n基点: ")
count 0)
(prompt "\n位移的第二点: ")
(setq len (sslength sset))
(while (< count len)
(setq name (ssname sset count)
ptlst (entget name)
b (assoc 8 ptlst)
b1 (cdr (assoc 8 ptlst))
c (cons 8 c_layer)
d (subst c b ptlst)
count (1+ count))
(entmod d)
)
(command "copy" sset "" pt1 pause)
(setq count 0)
(while (< count len)
(setq name (ssname sset count)
ptlst (entget name)
b (assoc 8 ptlst)
c (cons 8 b1)
d (subst c b ptlst)
count (1+ count))
(entmod d)
)
(princ)
)
全部回复(1 )
只看楼主 我来说两句 抢板凳