明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 577|回复: 11

画出当前文件所有图层

  [复制链接]
发表于 2022-6-16 21:28 | 显示全部楼层 |阅读模式
本帖最后由 xj6019 于 2022-6-17 16:36 编辑


画出当前文件所有图层
(defun C:NM (/ *acad* *doc* *lays* outlst p1)
        (setq
                *ACAD*  (vlax-get-acad-object)
                *DOC*   (vla-get-ActiveDocument *ACAD*)
                *LAYS*  (vla-get-Layers *DOC*)
        )
        (setq p1 (getpoint "\n请指定插入点:"))
        (mapcar '(lambda(a)
                                                 (setq ps1(polar p1 0 200))
                                                 (setq ps2(polar p1 0 350))
                                                 (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 ps1)))
                                                 (vla-put-layer (vlax-ename->vla-object (entlast)) a)
                                                 (entmake (list '(0 . "TEXT") (cons 1 a)(cons 50 0) (cons 10 ps2) (cons 11 ps2) (cons 72 1) (cons 73 2) (cons 40 20)))
                                                 (vla-put-layer (vlax-ename->vla-object (entlast)) a)
                                                 (setq p1(polar p1 (* 1.5 pi) 50))
                                         )
                (vlax-for obj  *LAYS*  (setq outlst (cons (vlax-get-property obj 'Name) outlst)))
        )
        (princ)
)

选择图元写出图层名

(defun c:NM(/ dxf lst p1 ss)
        (defun dxf (ent i) (cdr (assoc i (entget ent))))
        (setq tclst nil)
        (if(and (setq ss (ssget) )
                         (setq p1 (getpoint "\n请指定插入点:"))
                 )
          (mapcar '(lambda(a)   
                                                         (if(member (dxf a 8) tclst)(princ)
                                                                 (progn
                                                                         (entmake (list '(0 . "TEXT") (cons 1 (dxf a 8))(cons 50 0) (cons 10 p1) (cons 11 p1) (cons 72 1) (cons 73 2) (cons 40 20)))                                                                        
                                                                         (vla-put-layer (vlax-ename->vla-object (entlast)) (dxf a 8))
                                                                         (setq p1(polar p1 (* 1.5 pi) 50))
                                                                 )
                                                         )
                                                         (setq tclst(cons (dxf a 8) tclst))
                                                 )        
                        (vl-remove-if-not '(lambda(x)(= 'ENAME (type x))) (mapcar 'cadr (ssnamex SS)))
                )
        )
        (princ)
)

评分

参与人数 6明经币 +5 金钱 +20 收起 理由
xmq1103 + 1 赞一个!
1165617649 + 20
yyz123121 + 1
start4444 + 1 很给力!
趣意人生 + 1 很给力!
dtucad + 1 很给力!

查看全部评分

 楼主| 发表于 2022-6-17 12:16 | 显示全部楼层
999999 发表于 2022-6-17 09:22
厉害呀,以前是别人帮您解决问题,现在是您帮别人解决问题,,一份明经精神的传承

嘿嘿嘿嘿,瞎玩一把
发表于 2022-6-21 11:26 | 显示全部楼层
谢谢分享,用来制作公司的制图标准时候可以用到,将现有图层画出直线以及将图层名写出来。
发表于 2022-6-17 09:22 | 显示全部楼层
厉害呀,以前是别人帮您解决问题,现在是您帮别人解决问题,,一份明经精神的传承
发表于 2022-6-18 07:35 | 显示全部楼层
好程序,下载表示支持
发表于 2022-6-18 11:09 | 显示全部楼层
感谢您为大家提供优质便捷程序。
发表于 2022-6-19 11:59 | 显示全部楼层
好程序,下载表示支持
发表于 2022-6-19 14:11 | 显示全部楼层
NM
牛码
谢谢分享
发表于 2022-6-21 10:40 | 显示全部楼层
感谢分享,很好用
发表于 2022-6-21 20:54 | 显示全部楼层
谢谢分享,小工具挺好用。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2022-6-30 16:10 , Processed in 0.147374 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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