列出所有图层实体数量

marting

1. (defun c:layercount (/ lst)
   
2.   (vlax-for blk (vla-get-blocks
   
3.                   (vla-get-activedocument (vlax-get-acad-object))
   
4.                 )
   
5.     (vlax-for obj blk
   
6.       (setq lst (layercount:assoc++ (vla-get-layer obj) lst))
   
7.       (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
   
8.                (= :vlax-true (vla-get-hasattributes obj))
   
9.           )
   
10.         (foreach att (vlax-invoke obj 'getattributes)
    
11.           (setq lst (layercount:assoc++ (vla-get-layer att) lst))
    
12.         )
    
13.       )
    
14.     )
    
15.   )
    
16.   (princ (layercount:padbetween "\n\n" "" "-" 62))
    
17.   (princ (layercount:padbetween "\nLayer" "Objects" " " 61))
    
18.   (princ (layercount:padbetween "\n" "" "-" 61))
    
19.   (foreach itm (vl-sort lst '(lambda (a b) (> (cdr a) (cdr b))))
    
20.     (princ (layercount:padbetween
    
21.              (strcat "\n" (car itm))
    
22.              (itoa (cdr itm))
    
23.              "."
    
24.              61
    
25.            )
    
26.     )
    
27.   )
    
28.   (princ (layercount:padbetween "\n" "" "-" 61))
    
29.   (princ (layercount:padbetween
    
30.            "\nTotal"
    
31.            (itoa (apply '+ (mapcar 'cdr lst)))
    
32.            "."
    
33.            61
    
34.          )
    
35.   )
    
36.   (princ (layercount:padbetween "\n" "" "-" 61))
    
37.   (textpage)
    
38.   (princ)
    
39. )
    
40. (defun layercount:assoc++ (key lst / itm)
    
41.   (if (setq itm (assoc key lst))
    
42.     (subst (cons key (1+ (cdr itm))) itm lst)
    
43.     (cons (cons key 1) lst)
    
44.   )
    
45. )
    
46. (defun layercount:padbetween (s1 s2 ch ln)
    
47.   ((lambda (a b c)
    
48.      (repeat (- ln (length b) (length c)) (setq c (cons a c)))
    
49.      (vl-list->string (append b c))
    
50.    )
    
51.     (ascii ch)
    
52.     (vl-string->list s1)
    
53.     (vl-string->list s2)
    
54.   )
    
55. )
    
56. 
    
57. (vl-load-com)
    
58. (princ)
    
59. 
    

(defun c:layercount (/ lst)<br />   (vlax-for blk (vla-get-blocks<br />                   (vla-get-activedocument (vlax-get-acad-object))<br />                 )<br />     (vlax-for obj blk<br />       (setq lst (layercount:assoc++ (vla-get-layer obj) lst))<br />       (if (and (= "AcDbBlockReference" (vla-get-objectname obj))<br />                (= :vlax-true (vla-get-hasattributes obj))<br />           )<br />         (foreach att (vlax-invoke obj 'getattributes)<br />           (setq lst (layercount:assoc++ (vla-get-layer att) lst))<br />         )<br />       )<br />     )<br />   )<br />   (princ (layercount:padbetween "\n\n" "" "-" 62))<br />   (princ (layercount:padbetween "\nLayer" "Objects" " " 61))<br />   (princ (layercount:padbetween "\n" "" "-" 61))<br />   (foreach itm (vl-sort lst '(lambda (a b) (> (cdr a) (cdr b))))<br />     (princ (layercount:padbetween<br />              (strcat "\n" (car itm))<br />              (itoa (cdr itm))<br />              "."<br />              61<br />            )<br />     )<br />   )<br />   (princ (layercount:padbetween "\n" "" "-" 61))<br />   (princ (layercount:padbetween<br />            "\nTotal"<br />            (itoa (apply '+ (mapcar 'cdr lst)))<br />            "."<br />            61<br />          )<br />   )<br />   (princ (layercount:padbetween "\n" "" "-" 61))<br />   (textpage)<br />   (princ)<br /> )<br /> (defun layercount:assoc++ (key lst / itm)<br />   (if (setq itm (assoc key lst))<br />     (subst (cons key (1+ (cdr itm))) itm lst)<br />     (cons (cons key 1) lst)<br />   )<br /> )<br /> (defun layercount:padbetween (s1 s2 ch ln)<br />   ((lambda (a b c)<br />      (repeat (- ln (length b) (length c)) (setq c (cons a c)))<br />      (vl-list->string (append b c))<br />    )<br />     (ascii ch)<br />     (vl-string->list s1)<br />     (vl-string->list s2)<br />   )<br /> )<br /> <br /> (vl-load-com)<br /> (princ)<br /> <br />

开心68602

感谢老师分享

coverne

感谢老师分享

qyming2000

感谢老师分享

yoyoho

感谢分享!!!!!!!