entget无法读取外部dwg的图元扩展数据的替代方法

dcl1214

有时需要读取外部dwg图纸的扩展，entget无法读取，但是，vla方法是支持的（感谢高老师指点），代码如下：

1. (defun $kuo-zhan-du-qu-vla$ (object   lst      /        a
   
2.                              app      types    v        values
   
3.                              values-variant    vs        vss
   
4.                              xtype    xvalue
   
5.                             )
   
6.        ;vla方法读取扩展数据【这个函数主要是用来解决dbx读取外部dwg的时候，entget无法读取扩展数据的问题】
   
7.   (setq        xtype nil
   
8.         xvalue nil
   
9.         vss nil
   
10.         app nil
    
11.         vs nil
    
12.   )
    
13.   (cond        ((= (type object) 'vla-object) t)
    
14.         ((= (type object) 'ename)
    
15.          (setq object (vlax-ename->vla-object object))
    
16.         )
    
17.         (t (setq object nil))
    
18.   )
    
19.   (and object
    
20.        (progn
    
21.          (vl-catch-all-apply
    
22.            'vla-getxdata
    
23.            (list object "" 'xtype 'xvalue)
    
24.          )
    
25.          (and xtype
    
26.               xvalue
    
27.               (progn
    
28.                 (setq types (vl-catch-all-apply
    
29.                               'vlax-safearray->list
    
30.                               (list xtype)
    
31.                             )
    
32.                 )
    
33.                 (setq object nil)
    
34.                 (setq values-variant
    
35.                        (vl-catch-all-apply
    
36.                          'vlax-safearray->list
    
37.                          (list xvalue)
    
38.                        )
    
39.                 )
    
40.               )
    
41.          )
    
42.          (if (vl-catch-all-error-p values-variant)
    
43.            (setq values-variant nil)
    
44.          )
    
45.          (setq values (mapcar 'vlax-variant-value values-variant))         
    
46.          (while        (and (setq a (car types))
    
47.                      (setq v (car values))
    
48.                 )
    
49.            (or app (setq app v))
    
50.            (and        (not (= a 1001))
    
51.                 (progn
    
52.                   (and (not (= a 1002))
    
53.                        (setq vs (cons (cons a v) vs))
    
54.                   )
    
55.                 )
    
56.            )
    
57.            (and        (= (cadr types) 1001)
    
58.                 (progn
    
59.                   (setq vss (cons (cons app (reverse vs)) vss))
    
60.                   (setq vs nil)
    
61.                   (setq app nil)
    
62.                 )
    
63.            )
    
64.            (setq types (cdr types))
    
65.            (setq values (cdr values))
    
66.          )
    
67.          (setq vss (cons (cons app (reverse vs)) vss))
    
68.          (setq vss (reverse vss))
    
69.          (setq vs nil)
    
70.        )
    
71.   )
    
72.   vss
    
73. )

(defun $kuo-zhan-du-qu-vla$ (object   lst      /        a<br />                              app      types    v        values<br />                              values-variant    vs        vss<br />                              xtype    xvalue<br />                             )<br />        ;vla方法读取扩展数据【这个函数主要是用来解决dbx读取外部dwg的时候，entget无法读取扩展数据的问题】<br />   (setq        xtype nil<br />         xvalue nil<br />         vss nil<br />         app nil<br />         vs nil<br />   )<br />   (cond        ((= (type object) 'vla-object) t)<br />         ((= (type object) 'ename)<br />          (setq object (vlax-ename->vla-object object))<br />         )<br />         (t (setq object nil))<br />   )<br />   (and object<br />        (progn<br />          (vl-catch-all-apply<br />            'vla-getxdata<br />            (list object "" 'xtype 'xvalue)<br />          )<br />          (and xtype<br />               xvalue<br />               (progn<br />                 (setq types (vl-catch-all-apply<br />                               'vlax-safearray->list<br />                               (list xtype)<br />                             )<br />                 )<br />                 (setq object nil)<br />                 (setq values-variant<br />                        (vl-catch-all-apply<br />                          'vlax-safearray->list<br />                          (list xvalue)<br />                        )<br />                 )<br />               )<br />          )<br />          (if (vl-catch-all-error-p values-variant)<br />            (setq values-variant nil)<br />          )<br />          (setq values (mapcar 'vlax-variant-value values-variant))         <br />          (while        (and (setq a (car types))<br />                      (setq v (car values))<br />                 )<br />            (or app (setq app v))<br />            (and        (not (= a 1001))<br />                 (progn<br />                   (and (not (= a 1002))<br />                        (setq vs (cons (cons a v) vs))<br />                   )<br />                 )<br />            )<br />            (and        (= (cadr types) 1001)<br />                 (progn<br />                   (setq vss (cons (cons app (reverse vs)) vss))<br />                   (setq vs nil)<br />                   (setq app nil)<br />                 )<br />            )<br />            (setq types (cdr types))<br />            (setq values (cdr values))<br />          )<br />          (setq vss (cons (cons app (reverse vs)) vss))<br />          (setq vss (reverse vss))<br />          (setq vs nil)<br />        )<br />   )<br />   vss<br /> )

yanshengjiang

高老师肯定是桌子公司的卧底