明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1236|回复: 12

[提问] 加边框如何指定到图层9

[复制链接]
发表于 2016-8-1 13:46:59 | 显示全部楼层 |阅读模式
本帖最后由 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))

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2016-8-1 20:43:51 | 显示全部楼层
本帖最后由 llsheng_73 于 2023-6-14 16:29 编辑

  1. (defun c:tt (/ bx pt p1 p2)
  2.   (vl-load-com)
  3.   (if(not(TBLOBJNAME"layer""图层9"))
  4.     (entmakex'((0 . "LAYER")(100 . "AcDbSymbolTableRecord")(100 . "AcDbLayerTableRecord")(2 . "图层9")(70 . 0))))
  5.   (setq bx(getdist "\n输入四周间隔: ")
  6.         bx(list bx bx))
  7.   (while(setq pt(princ "\n选择加框物体: ")pt(ssget))
  8.     (setq pt(apply'append(mapcar'(lambda(x / p1 p2)
  9.        (if(equal(type(cadr x))'ename)
  10.        (progn  (vla-getboundingbox(vlax-ename->vla-object(cadr x))'p1 'p2)
  11.                                    (mapcar'vlax-safearray->list(list p1 p2)))))(ssnamex pt)))
  12.           p1(mapcar '-(apply 'mapcar (cons 'min pt))bx)
  13.           p2(mapcar '+(apply 'mapcar (cons 'max pt))bx))
  14.     (entmakex(list'(0 . "lwpolyline")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(8 . "图层9")'(90 . 4)'(70 . 1)
  15.                    (cons 10 p1)(list 10(car p1)(cadr p2))(cons 10 p2)(list 10(car p2)(cadr p1))))
  16.     ))
发表于 2023-6-14 17:02:51 | 显示全部楼层
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 16:29:43 | 显示全部楼层
水洗可口可乐 发表于 2023-6-14 14:46
选择对象:
原因:参数太多 位置-> 行:14 列:6

最后画框的时候,list的反括号位置给早了,现在修改了
发表于 2016-8-1 14:50:17 | 显示全部楼层
可在加框前
(setvar "CLayer"  "图层9")   ; "图层9" 得合在状态中

或在加框后
用chprop 或 直接修改 entity list
发表于 2016-8-1 16:43:05 | 显示全部楼层
  1. (defun c:tt ()
  2.   (setvar "CMDECHO" 0)
  3.   (vl-load-com)
  4.   (setq bx (getdist "\nEnter Around Space 输入四周间隔: "))
  5.   (while (progn (princ "\n选择加框物体: ") (setq ss (ssget)))
  6.     (setq i    -1
  7.           plst (list)
  8.     )
  9.     (repeat (sslength ss)
  10.       (setq en (ssname ss (setq i (1+ i))))
  11.       (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
  12.       (setq plst (append plst
  13.                          (list (vlax-safearray->list p1)
  14.                                (vlax-safearray->list p2)
  15.                          )
  16.                  )
  17.       )
  18.     )
  19.     (setq p1 (apply 'mapcar (cons 'min plst)))
  20.     (setq p2 (apply 'mapcar (cons 'max plst)))
  21.     (setq p1 (mapcar '- p1 (list bx bx)))
  22.     (setq p2 (mapcar '+ p2 (list bx bx)))
  23.     (command "_.RECTANG" p1 p2)
  24.     (setq las (entlast))
  25.     (command "_.chprop" las "" "LA" "图层9" "")
  26.   )
  27.   (setvar "CMDECHO" 1)
  28.   (prin1)
  29. )
发表于 2016-8-2 08:46:47 | 显示全部楼层
llsheng_73 发表于 2016-8-1 20:43

llsheng_73,你这个只是新建了个图层9,那个框没有在图层9上啊
发表于 2016-8-2 09:15:09 | 显示全部楼层
llsheng_73 发表于 2016-8-1 20:43

大哥,有笔误
(entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline")(8 . "图层9")(90 . 4)(70 . 1))

点评

火眼金睛,确实笔误  发表于 2016-8-2 10:37
 楼主| 发表于 2016-8-3 13:39:34 | 显示全部楼层
llsheng_73 发表于 2016-8-1 20:43

你好,我是想把加的边框统一放到layer9这个层或者layer7,不是新建一个图层9,麻烦帮修改一下,谢谢
 楼主| 发表于 2016-8-3 13:55:32 | 显示全部楼层
(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))
在琴剑江山提供的代码修改了图层名称,达到了我需要的效果,谢谢各位大神的帮助,
发表于 2016-8-3 14:13:07 | 显示全部楼层
monuow 发表于 2016-8-3 13:39
你好,我是想把加的边框统一放到layer9这个层或者layer7,不是新建一个图层9,麻烦帮修改一下,谢谢

并不是给你新建了一个图层9,而是检查有没有图层9,如果没有才新建,后边画框的时候才能直接往图层9上画
你要放到layer9或者layer7,把图层9改成layer9或者layer7就可以了
发表于 2023-6-14 14:46:40 | 显示全部楼层

选择对象:
原因:参数太多 位置-> 行:14 列:6


CAD2007
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-16 20:28 , Processed in 0.193652 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表