加边框如何指定到图层9
本帖最后由 monuow 于 2016-8-1 14:39 编辑这是我在论坛找的加边框程序，但加的边框是随层的，如果指定到图层9品色或其它图层，如图，因为工作中需要大量执行加边框，然后变图层，所以想一步到位，把加的边框，默认变成我指定的其它图层
(defun c:tt() (setvar "CMDECHO" 0) (vl-load-com) (setq bx (getdist "\nEnter Around Space 输入四周间隔: ")) (while (progn (princ "\n选择加框物体: ") (setq ss (ssget)))(setq i -1 plst (list))(repeat (sslength ss) (setq en (ssname ss (setq i (1+ i)))) (vla-getboundingbox(vlax-ename->vla-object en) 'p1 'p2) (setq plst (append plst (list(vlax-safearray->list p1)(vlax-safearray->list p2)))))(setq p1 (apply 'mapcar (cons 'min plst)))(setq p2 (apply 'mapcar (cons 'max plst)))(setq p1 (mapcar '- p1 (list bx bx)))(setq p2 (mapcar '+ p2 (list bx bx)))(command "_.RECTANG" p1 p2) ) (setvar "CMDECHO" 1) (prin1)) 本帖最后由 llsheng_73 于 2023-6-14 16:29 编辑
(defun c:tt (/ bx pt p1 p2)
(vl-load-com)
(if(not(TBLOBJNAME"layer""图层9"))
(entmakex'((0 . "LAYER")(100 . "AcDbSymbolTableRecord")(100 . "AcDbLayerTableRecord")(2 . "图层9")(70 . 0))))
(setq bx(getdist "\n输入四周间隔: ")
bx(list bx bx))
(while(setq pt(princ "\n选择加框物体: ")pt(ssget))
(setq pt(apply'append(mapcar'(lambda(x / p1 p2)
(if(equal(type(cadr x))'ename)
(progn(vla-getboundingbox(vlax-ename->vla-object(cadr x))'p1 'p2)
(mapcar'vlax-safearray->list(list p1 p2)))))(ssnamex pt)))
p1(mapcar '-(apply 'mapcar (cons 'min pt))bx)
p2(mapcar '+(apply 'mapcar (cons 'max pt))bx))
(entmakex(list'(0 . "lwpolyline")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(8 . "图层9")'(90 . 4)'(70 . 1)
(cons 10 p1)(list 10(car p1)(cadr p2))(cons 10 p2)(list 10(car p2)(cadr p1))))
)) llsheng_73 发表于 2023-6-14 16:29
最后画框的时候，list的反括号位置给早了，现在修改了
(entmakex(list'(0 . "lwpolyline")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(8 . "图层9")'(90 . 4)'(70 . 1)
测试OK了，谢谢你 水洗可口可乐 发表于 2023-6-14 14:46
选择对象:
原因：参数太多 位置-> 行:14 列:6
最后画框的时候，list的反括号位置给早了，现在修改了 可在加框前
(setvar "CLayer""图层9") ; "图层9" 得合在状态中
或在加框后
用chprop 或 直接修改 entity list
(defun c:tt ()
(setvar "CMDECHO" 0)
(vl-load-com)
(setq bx (getdist "\nEnter Around Space 输入四周间隔: "))
(while (progn (princ "\n选择加框物体: ") (setq ss (ssget)))
(setq i -1
plst (list)
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i))))
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq plst (append plst
(list (vlax-safearray->list p1)
(vlax-safearray->list p2)
)
)
)
)
(setq p1 (apply 'mapcar (cons 'min plst)))
(setq p2 (apply 'mapcar (cons 'max plst)))
(setq p1 (mapcar '- p1 (list bx bx)))
(setq p2 (mapcar '+ p2 (list bx bx)))
(command "_.RECTANG" p1 p2)
(setq las (entlast))
(command "_.chprop" las "" "LA" "图层9" "")
)
(setvar "CMDECHO" 1)
(prin1)
) llsheng_73 发表于 2016-8-1 20:43 static/image/common/back.gif
llsheng_73，你这个只是新建了个图层9，那个框没有在图层9上啊 llsheng_73 发表于 2016-8-1 20:43 static/image/common/back.gif
大哥，有笔误
(entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline")(8 . "图层9")(90 . 4)(70 . 1)) llsheng_73 发表于 2016-8-1 20:43 static/image/common/back.gif
你好，我是想把加的边框统一放到layer9这个层或者layer7，不是新建一个图层9，麻烦帮修改一下，谢谢 (defun c:bk ()(setvar "CMDECHO" 0)(vl-load-com)(setq bx (getdist "\nEnter Around Space 输入四周间隔: "))(while (progn (princ "\n选择加框物体: ") (setq ss (ssget))) (setq i -1 plst (list) ) (repeat (sslength ss) (setq en (ssname ss (setq i (1+ i)))) (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2) (setq plst (append plst (list (vlax-safearray->list p1) (vlax-safearray->list p2) ) ) ) ) (setq p1 (apply 'mapcar (cons 'min plst))) (setq p2 (apply 'mapcar (cons 'max plst))) (setq p1 (mapcar '- p1 (list bx bx))) (setq p2 (mapcar '+ p2 (list bx bx))) (command "_.RECTANG" p1 p2) (setq las (entlast)) (command "_.chprop" las "" "LA" "layer6" ""))(setvar "CMDECHO" 1)(prin1))
在琴剑江山提供的代码修改了图层名称，达到了我需要的效果，谢谢各位大神的帮助，
monuow 发表于 2016-8-3 13:39 static/image/common/back.gif
你好，我是想把加的边框统一放到layer9这个层或者layer7，不是新建一个图层9，麻烦帮修改一下，谢谢
并不是给你新建了一个图层9，而是检查有没有图层9，如果没有才新建，后边画框的时候才能直接往图层9上画
你要放到layer9或者layer7,把图层9改成layer9或者layer7就可以了 llsheng_73 发表于 2016-8-1 20:43
选择对象:
原因：参数太多 位置-> 行:14 列:6
CAD2007
页:
[1]
2