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

jeepsheep 发表于 2004-10-18 10:45:00

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

例如画室内的家具时(当前层为家具层),我OFFSET墙线600作为柜的边线,想新物体(在墙的层)直接为当前层:家具层.

谢谢!

bbo 发表于 2004-10-28 17:56:00

我也很想知道

citykunan 发表于 2004-10-29 17:03:00

BBO你能不能发点有用的帖，一连串的都是废帖，版主应该管管，提高明经帖子的质量是提高明经声誉的重要组成部分。

spring 发表于 2004-10-29 17:39:00

(defun c:aa (/ clay dist en p2) (setq clay (getvar "clayer")) (initget 1) (setq dist (getreal "\n请输入偏移距离:")) (while (setq en (entsel "\n请选择图元:")) (if en (progn (setq p2 (getpoint (osnap (cadr en) "nea") "\n请指定方向:")) (command "_.offset" dist (car en) p2 "") (command "_.change" (entlast) "" "P" "la" clay "") ) ) ) (princ) )

meflying 发表于 2004-10-29 17:40:00

用of1代替offset命令,copy一样做...

(defun c:Of1() (setvar "cmdecho" 1) (command "_.offset") (while (= (getvar "cmdactive") 1) (command pause) ) (setvar "cmdecho" 0) (command "_.change" (entlast) "" "p" "la" (getvar "clayer") "") (princ) )

jeepsheep 发表于 2004-10-30 10:52:00

我这有晓东CAD那帮我写的,简单明了!

;;;COPY物体到当前层 (defun c:cv () (vl-load-com) (vl-cmdf "copy" pause pause pause pause) (setq obj (vlax-ename->vla-object (entlast))) (vla-put-layer obj (getvar "clayer")) )

pfrynwgkq 发表于 2004-11-3 23:36:00

我是一个不懂偏程的家伙、、要向懂的大侠看齐。

用了上面大侠偏的觉得如果能改一下就好啦。我是做建筑的这个我都经常用。所以嘛~~~~

如果4楼里面加上《在图上点选距离就好啦。

5楼的大哥只能一次一次的offse这样对工作量大的就有点烦啦。

如果可以做一个循环就完美了。

6楼的。我也试过啦。不过出错的频率很高。

meflying 发表于 2004-11-4 08:35:00

offset命令本身就可以循环的,只是我的程序只将最后一个对象修改到当前层,以下进行了修正(defun c:Of2( / ent ents)
(setvar "cmdecho" 1)
(setq ent (entlast))
(command "_.offset" pause)
(while (= (getvar "cmdactive") 1)
   (command pause)
   (if (not (equal ent (entlast)))
      (progn
(setq ents (entget (entlast)))
(setq ents (subst (cons 8 (getvar "clayer")) (assoc 8 ents) ents))
(entmod ents)
      )
   )
)
(princ)
)

pfrynwgkq 发表于 2004-11-6 01:41:00

谢了。

jeepsheep 发表于 2004-12-2 11:34:00

;clone.lsp ;复制所选对象到另一个层，不移动其原始位置。

(defun C:CF( / s l) (setvar "cmdecho" 0) (if (and (setq s (ssget)) (not (zerop (sslength s))) (not (zerop (strlen (setq l (getstring "\n要复制到的层： ")))))) (command "copy" s "" "@" "@" "change" s "" "p" "la" l "") (prompt "Invalid.")) (progn) )

 ; copylay.lsp ; 复制到当前层（copy_to_layer）。 ;本程序将复制一个实体到当前层无论它在哪个层。

(defun C:cpc () (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) ) 我这有两个LISP,能否帮忙改改,让它们合并成:拷贝物体到当前层,不移动其原始位置。或者改第一个LISP,使的选层时能跳出选层的对话框(选项有:选当前层,选层列表中的任意层),免得有的层名太长不好记!

页: [1] 2

明经CAD社区's Archiver

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