社区 › Auto Lisp › 画出当前文件所有图层

xj6019 发表于 2022-6-16 21:28:00

画出当前文件所有图层

画出当前文件所有图层
(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:00

(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)
)

刘炎华 发表于 2022-7-27 14:27:00

非常感谢哦！

xj6019 发表于 2022-6-17 12:16:00

嘿嘿嘿嘿，瞎玩一把

999999 发表于 2022-6-17 09:22:00

厉害呀，以前是别人帮您解决问题，现在是您帮别人解决问题，，一份乐筑天下精神的传承

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

好程序，下载表示支持

whophy 发表于 2022-6-18 11:09:00

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

fxlt619 发表于 2022-6-19 11:59:00

好程序，下载表示支持

lxl217114 发表于 2022-6-19 14:11:00

NM
牛码
谢谢分享

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

感谢分享，很好用

查看完整版本: 画出当前文件所有图层