[求LISP]求COPY和OFFSET新物体使之到当前层! - 编程申请 - AutoCAD论坛 - 明经CAD社区 - 第2页

xstlf 发表于 2004-12-17 16:27:00

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

332888 发表于 2004-12-22 14:27:00

在网路上找到的试试看

(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 发表于 2004-12-26 23:38:00

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

andyding 发表于 2005-3-3 20:22:00

我也来凑下热闹!!!

我用最简间的办法做.

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

山姆发表于 2005-3-23 23:56:00

andyding发表于2005-3-3 20:22:00static/image/common/back.gif我也来凑下热闹!!!

我用最简间的办法做.

(DEFUN C:CU() (setq pp (ssget)) (setq LAY (getvar \"CLAYER\")) (COMMAND \"C...

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

Gu_xl 发表于 2005-4-1 12:42:00

偏移到当前层命令：

(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 发表于 2005-4-1 12:43:00

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

页: 1 [2]

明经CAD社区's Archiver