[求LISP]求COPY和OFFSET新物体使之到当前层!

xstlf

meflying老师，我试过，Copy的话，若选择多个实体进行copy。只会把多个实体中的最后一个变成当前层的，若让多个实体一起变成当前层,应该用什么方法呀？

332888

在网路上找到的试试看 (defun C:` (/ SS FLS ENT CL) ;复制层(`在esc键下方)
(vl-load-com)
(command "_.ucs" "") (prompt "\Copy * Layer")
(setq SS (ssget))
(setq FLS (LAYERR))
(setq CL (getvar "clayer"))
(foreach ENT FLS
(setq ENT (vl-princ-to-string ENT))
(if (not (tblsearch "layer" ENT))
(command "layer" "m" ENT "")
)
(command "copy" SS "" "0,0" "0,0")
(command "change" SS "" "P" "la" ENT "")
)
(command "_.ucs" "p")
(setvar "clayer" CL)
(prin1)
)
(defun LAYERR (/ AJS FLS WORD LST1 N)
(setq AJS (getstring "\n输入层名/(选择图层) :")
LST1 ""
N 1
)
(if (= AJS "")
(setq FLS (list (cdr (assoc 8 (entget (car (entsel)))))))
(progn
(repeat (strlen AJS)
(setq WORD (substr AJS N 1))
(if (not (equal "," WORD))
(setq LST1 (strcat LST1 WORD))
(progn
(setq FLS (append FLS (list LST1))
LST1 ""
)
)
)
(setq N (1+ N))
)
(if (not (equal LST1 ""))
(setq FLS (append FLS (list LST1)))
FLS
)
)
)
)

jeepsheep

能否不输图层名吗?哪能记得这么多!直接变成当前层多好,要不就做成对话框选图层!

andyding

我也来凑下热闹!!! 我用最简间的办法做. (DEFUN C:CU() (setq pp (ssget))
(setq LAY (getvar "CLAYER"))
(COMMAND "COPY" pp "" "0,0" "0,0")
(COMMAND "CHPROP" "P" "" "LA" lay "LT" "bylayer" "C" "bylayer" "")(princ))
(DEFUN C:OC() (vl-cmdf "_.undo" "_group")
(mapcar 'princ (list "Current offset dist= " (getvar "OFFSETDIST")" "))
(setq di (getstring "\nEnter Offset Dist:"))
(setq o (ssget))
(setq po (getpoint "\nSide to offset"))
(setq LAY (getvar "CLAYER"))
(if (/= di nil)
(COMMAND "OFFSET" di o po "")
(COMMAND "CHPROP" "L" "" "LA" lay "LT" "bylayer" "C" "bylayer" ""))
(if (= di nil)
(COMMAND "OFFSET" "" o po "")
(COMMAND "CHPROP" "L" "" "LA" lay "LT" "bylayer" "C" "bylayer" ""))
(vl-cmdf "_.undo" "_end")(princ))

山姆

andyding发表于2005-3-3 20:22:00我也来凑下热闹!!! 我用最简间的办法做. (DEFUN C:CU() (setq pp (ssget)) (setq LAY (getvar \"CLAYER\")) (COMMAND \"C...

这两个程序好用,好好用,非常感谢

Gu_xl

偏移到当前层命令： (defun C:CLoffset (/ d dt e cl p cm nt)
(setierr)
(setq d (getvar "offsetdist")
cl (getvar "clayer")
)
(if (> d 0) (setq ds (rtos d 2) dt nil)
(setq ds "Through" dt t)
)
(initget 7 "Through ")
(setq d1 (getdist (strcat "\nOffset distance" "<" ds "> :")))
(if (= d1 "Through") (setq dt t)
(if (= d1 "") (if dt () (setq d1 d)) (setq dt nil))
)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
(while (not e)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
)
(if (= e "")
(abcdefg)
(redraw (car e) 3)
)
(setq p (getpoint "\nSide to offset?"))
(if dt (command ".offset" "T" e p "") (command ".offset" d1 e p ""))
(redraw (car e) 4)
(command "_change" (entlast) "" "p" "La" cl "c" "Bylayer" "lt" "bylayer" "")
(setq nt t)
(while nt
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
(while (not e)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
)
(if (= e "") (setq nt nil)
(progn
(redraw (car e) 3)
(setq p (getpoint "\nSide to offset?"))
(if dt (command ".offset" "T" e p "") (command ".offset" d1 e p ""))
(command "_change" (entlast) "" "p" "La" cl "c" "Bylayer" "lt" "bylayer" "")
(redraw (car e) 4)
)
)
)


(reerr)
(princ)
)

Gu_xl

(defun C:CLoffset (/ d dt e cl p cm nt)
(setierr)
(setq d (getvar "offsetdist")
cl (getvar "clayer")
)
(if (> d 0) (setq ds (rtos d 2) dt nil)
(setq ds "Through" dt t)
)
(initget 7 "Through ")
(setq d1 (getdist (strcat "\nOffset distance" "<" ds "> :")))
(if (= d1 "Through") (setq dt t)
(if (= d1 "") (if dt () (setq d1 d)) (setq dt nil))
)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
(while (not e)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
)
(if (= e "")
(abcdefg)
(redraw (car e) 3)
)
(setq p (getpoint "\nSide to offset?"))
(if dt (command ".offset" "T" e p "") (command ".offset" d1 e p ""))
(redraw (car e) 4)
(command "_change" (entlast) "" "p" "La" cl "c" "Bylayer" "lt" "bylayer" "")
(setq nt t)
(while nt
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
(while (not e)
(initget 7 " ")
(setq e (entsel "\nSelect object to offset :"))
)
(if (= e "") (setq nt nil)
(progn
(redraw (car e) 3)
(setq p (getpoint "\nSide to offset?"))
(if dt (command ".offset" "T" e p "") (command ".offset" d1 e p ""))
(command "_change" (entlast) "" "p" "La" cl "c" "Bylayer" "lt" "bylayer" "")
(redraw (car e) 4)
)
)
)


(reerr)
(princ)
)