画出当前文件所有图层

xj6019 · 发表于 2022-6-16 21:28:59

本帖最后由 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)
)

xj6019 · 发表于 2022-7-27 14:11:15

刘炎华发表于 2022-7-27 13:53
就是选择对象后，将它在原位置复制到文件的每个图层

(defun c:NM (/ *acad* *doc* *lays* i laylst s1 ss)
(setq
*ACAD*  (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
*LAYS*  (vla-get-Layers *DOC*)
laylst nil
)
(vlax-for obj  *LAYS*  (setq laylst (cons (vlax-get-property obj 'Name) laylst)))
  (if (setq ss (ssget))
   (mapcar '(lambda(a)
   (setvar "clayer" a)
   (command "COPY" ss "" '(0 0) '(0 0))
   (setq ssa (ssget "P"))
   (setq i -1)
   (while (and(setq s1 (ssname ssa (setq i (1+ i)))))
   (vla-put-Layer  (Vlax-Ename->Vla-Object s1) a)
   )
   )
laylst
)
)
(princ)
)

llsheng_73 · 发表于 2022-9-26 15:34:44

xj6019 发表于 2022-7-27 14:11
(defun c:NM (/ *acad* *doc* *lays* i laylst s1 ss)
(setq
*ACAD* (vlax-get-acad-object)

选一堆东西，复制到每一个图层的作用是什么？

下文没句号。 · 发表于 2022-10-11 14:52:42

xj6019 发表于 2022-7-27 14:11
(defun c:NM (/ *acad* *doc* *lays* i laylst s1 ss)
(setq
*ACAD* (vlax-get-acad-object)

你和楼主的这个完全不是一个

999999 · 发表于 2022-6-17 09:22:25

厉害呀，以前是别人帮您解决问题，现在是您帮别人解决问题，

，一份明经精神的传承

xj6019 · 发表于 2022-6-17 12:16:24

999999 发表于 2022-6-17 09:22
厉害呀，以前是别人帮您解决问题，现在是您帮别人解决问题，，一份明经精神的传承

嘿嘿嘿嘿，瞎玩一把

完整武器 · 发表于 2022-6-18 07:35:59

好程序，下载表示支持

whophy · 发表于 2022-6-18 11:09:28

感谢您为大家提供优质便捷程序。

fxlt619 · 发表于 2022-6-19 11:59:43

好程序，下载表示支持

lxl217114 · 发表于 2022-6-19 14:11:43

NM
牛码
谢谢分享

海盗曹 · 发表于 2022-6-21 10:40:19

感谢分享，很好用

yyz123121 · 发表于 2022-6-21 11:26:04

谢谢分享，用来制作公司的制图标准时候可以用到，将现有图层画出直线以及将图层名写出来。

chixun99 · 发表于 2022-6-21 20:54:07

谢谢分享，小工具挺好用。

账号		自动登录	找回密码
密码			注册

画出当前文件所有图层

评分