画出当前文件所有图层

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