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

jeepsheep

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



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


谢谢!

bbo

我也很想知道

citykunan

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

spring

(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

用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

我这有晓东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

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


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


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


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


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


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

meflying

offset命令本身就可以循环的,只是我的程序只将最后一个对象修改到当前层,以下进行了修正

2. (defun c:Of2( / ent ents)
3.    (setvar "cmdecho" 1)
4.    (setq ent (entlast))
5.    (command "_.offset" pause)
6.    (while (= (getvar "cmdactive") 1)
7.        (command pause)
8.        (if (not (equal ent (entlast)))
9.            (progn
10.   (setq ents (entget (entlast)))
11.   (setq ents (subst (cons 8 (getvar "clayer")) (assoc 8 ents) ents))
12.   (entmod ents)
13.            )
14.        )
15.    )
16.    (princ)
17. )

(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

谢了。

jeepsheep

;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,使的选层时能跳出选层的对话框(选项有:选当前层,选层列表中的任意层),免得有的层名太长不好记!