读取块定义数据

dcl1214

同样的代码应该好多同仁写过，先当做笔记发个帖子吧

1. (defun $kuai-ding-yi$ (km lst / n obj objs i tag-ps)
   
2.                                         ;读取块定义的属性标记，同时按照Y轴排序
   
3.   (if (and km (tblsearch "block" km))
   
4.     (progn
   
5.       (setq
   
6.         obj
   
7.          (vl-catch-all-apply
   
8.            'vla-item
   
9.            (list (vla-get-blocks
   
10.                    (vla-get-activedocument (vlax-get-acad-object))
    
11.                  )
    
12.                  km
    
13.            )
    
14.          )
    
15.       )
    
16.       (if (vl-catch-all-error-p obj)
    
17.         (setq obj nil)
    
18.       )
    
19.       (setq objs nil)
    
20.       (setq i nil)
    
21.       (if obj
    
22.         (vlax-for i obj
    
23.           (setq n (vl-catch-all-apply 'vla-get-objectname (list i)))
    
24.           (if (vl-catch-all-error-p n)
    
25.             (setq n nil)
    
26.           )
    
27.           (and n (setq objs (cons i objs)))
    
28.         )
    
29.       )
    
30.       (setq tag-ps
    
31.              (mapcar
    
32.                (function
    
33.                  (lambda (a / tag pt)
    
34.                    (setq tag (vl-catch-all-apply 'vla-get-tagstring (LIST a)))
    
35.                    (IF(vl-catch-all-error-p tag)(SETQ tag NIL))
    
36.                    (IF tag(PROGN
    
37.                    (setq pt (vl-catch-all-apply
    
38.                               'vlax-safearray->list
    
39.                               (list (vl-catch-all-apply
    
40.                                       'vlax-variant-value
    
41.                                       (list (vl-catch-all-apply
    
42.                                               'vla-get-insertionpoint
    
43.                                               (list a)
    
44.                                             )
    
45.                                       )
    
46.                                     )
    
47.                               )
    
48.                             )
    
49.                    )
    
50.                    (cons tag pt)))
    
51.                  )
    
52.                )
    
53.                objs
    
54.              )
    
55.       )
    
56.       (SETQ tag-ps(VL-REMOVE NIL tag-ps))
    
57.       (setq
    
58.         tag-ps
    
59.          (vl-sort tag-ps
    
60.                   (function (lambda (e1 e2)
    
61.                               (> (cadr (cdr e1)) (cadr (cdr e2)))
    
62.                             )
    
63.                   )
    
64.          )
    
65.       )
    
66.     )
    
67.   )
    
68.   tag-ps
    
69. )

(defun $kuai-ding-yi$ (km lst / n obj objs i tag-ps)<br />                                         ;读取块定义的属性标记，同时按照Y轴排序<br />   (if (and km (tblsearch "block" km))<br />     (progn<br />       (setq<br />         obj<br />          (vl-catch-all-apply<br />            'vla-item<br />            (list (vla-get-blocks<br />                    (vla-get-activedocument (vlax-get-acad-object))<br />                  )<br />                  km<br />            )<br />          )<br />       )<br />       (if (vl-catch-all-error-p obj)<br />         (setq obj nil)<br />       )<br />       (setq objs nil)<br />       (setq i nil)<br />       (if obj<br />         (vlax-for i obj<br />           (setq n (vl-catch-all-apply 'vla-get-objectname (list i)))<br />           (if (vl-catch-all-error-p n)<br />             (setq n nil)<br />           )<br />           (and n (setq objs (cons i objs)))<br />         )<br />       )<br />       (setq tag-ps<br />              (mapcar<br />                (function<br />                  (lambda (a / tag pt)<br />                    (setq tag (vl-catch-all-apply 'vla-get-tagstring (LIST a)))<br />                    (IF(vl-catch-all-error-p tag)(SETQ tag NIL))<br />                    (IF tag(PROGN<br />                    (setq pt (vl-catch-all-apply<br />                               'vlax-safearray->list<br />                               (list (vl-catch-all-apply<br />                                       'vlax-variant-value<br />                                       (list (vl-catch-all-apply<br />                                               'vla-get-insertionpoint<br />                                               (list a)<br />                                             )<br />                                       )<br />                                     )<br />                               )<br />                             )<br />                    )<br />                    (cons tag pt)))<br />                  )<br />                )<br />                objs<br />              )<br />       )<br />       (SETQ tag-ps(VL-REMOVE NIL tag-ps))<br />       (setq<br />         tag-ps<br />          (vl-sort tag-ps<br />                   (function (lambda (e1 e2)<br />                               (> (cadr (cdr e1)) (cadr (cdr e2)))<br />                             )<br />                   )<br />          )<br />       )<br />     )<br />   )<br />   tag-ps<br /> )

guosheyang

感谢杜总的分享！

chslwj521

感谢昌哥分享

yk1216

谢谢大佬的分享

hubeiwdlue

感谢杜总的分享！