添加扩展数据、获取扩展数据

lea丶丶

2. ;;说明:添加扩展数据
   
3. ;;参数:e:可以为图元名也可以为有效的图元数据(entget en)
   
4. ;;参数:xdatas:'(("south" "3000" "1112")("south1" "4000" "1112"))
   
5. ;;返回:图元数据
   
6. (defun lea-xadat-put (e xdatas / ty app)
   
7.   (setq ty (type e)
   
8.     app (mapcar 'car xdatas);每一个
   
9.   )
   
10.   ;  (vl-every 'regapp app);every需要所有项都是真，碰到nil就结束了 ，碰到已注册的就结束了
    
11.   (foreach x app
    
12.     (if  (= (tblsearch "appid" x) nil)
    
13.       (regapp x);已注册的就不用注册了
    
14.     )
    
15.   )
    
16.   (if (member ty '(ENAME list))
    
17.     (entmod (append
    
18.               (if (= ty 'ENAME)(entget e) e)
    
19.               (list (cons -3
    
20.                       (mapcar ' (lambda (x) (cons (car x)
    
21.                                               (mapcar '(lambda (x)
    
22.                                                          (cons
    
23.                                                            (cond
    
24.                                                              ((= (type x) 'str) 1000);字符串
    
25.                                                              ((= (type x) 'real) 1040);实数
    
26.                                                              (t 1070)
    
27.                                                            )
    
28.                                                            x
    
29.                                                          )
    
30.                                                        )                                                
    
31.                                                 (cdr x)
    
32.                                               )
    
33.                                             )
    
34.                                 )
    
35.                         xdatas
    
36.                       )
    
37.                     )
    
38.               )
    
39.             )
    
40.     )
    
41.    
    
42.   )
    
43. )
    
44. ;;说明:获取扩展数据
    
45. ;;参数:en:图元名
    
46. ;;返回:扩展数据列表(("south" "4000" "1112") ("south1" "4000" "11342"))
    
47. (defun lea-xadat-get (en / lst)
    
48.   (if (and (= (type en) 'ename)
    
49.         (setq lst (cdr (assoc -3 (entget en '("*")))));(("south" (1000 . "4000") (1000 . "1112")) ("south1" (1000 . "4000") (1000 . "11342")))
    
50.       )
    
51.     (progn
    
52.       (mapcar '(lambda (x)
    
53.                  (mapcar '(lambda (x)
    
54.                             (if (= (type x) 'list) (cdr x) x)
    
55.                           )
    
56.                    x
    
57.                  )   
    
58.                )
    
59.         lst
    
60.       )
    
61.     )
    
62.   )
    
63. )
    

;;说明:添加扩展数据<br /> ;;参数:e:可以为图元名也可以为有效的图元数据(entget en)<br /> ;;参数:xdatas:'(("south" "3000" "1112")("south1" "4000" "1112"))<br /> ;;返回:图元数据<br /> (defun lea-xadat-put (e xdatas / ty app)<br />   (setq ty (type e)<br />     app (mapcar 'car xdatas);每一个<br />   )<br />   ;  (vl-every 'regapp app);every需要所有项都是真，碰到nil就结束了 ，碰到已注册的就结束了<br />   (foreach x app<br />     (if  (= (tblsearch "appid" x) nil)<br />       (regapp x);已注册的就不用注册了<br />     )<br />   )<br />   (if (member ty '(ENAME list))<br />     (entmod (append <br />               (if (= ty 'ENAME)(entget e) e)<br />               (list (cons -3 <br />                       (mapcar ' (lambda (x) (cons (car x)<br />                                               (mapcar '(lambda (x)<br />                                                          (cons <br />                                                            (cond <br />                                                              ((= (type x) 'str) 1000);字符串<br />                                                              ((= (type x) 'real) 1040);实数<br />                                                              (t 1070)<br />                                                            )<br />                                                            x<br />                                                          )<br />                                                        )                                                <br />                                                 (cdr x)<br />                                               )<br />                                             )<br />                                 )<br />                         xdatas<br />                       )<br />                     )<br />               )<br />             )<br />     )<br />     <br />   )<br /> )<br /> ;;说明:获取扩展数据<br /> ;;参数:en:图元名<br /> ;;返回:扩展数据列表(("south" "4000" "1112") ("south1" "4000" "11342"))<br /> (defun lea-xadat-get (en / lst)<br />   (if (and (= (type en) 'ename) <br />         (setq lst (cdr (assoc -3 (entget en '("*")))));(("south" (1000 . "4000") (1000 . "1112")) ("south1" (1000 . "4000") (1000 . "11342")))<br />       )<br />     (progn <br />       (mapcar '(lambda (x)<br />                  (mapcar '(lambda (x)<br />                             (if (= (type x) 'list) (cdr x) x)<br />                           )<br />                    x<br />                  )   <br />                )<br />         lst<br />       )<br />     )<br />   )<br /> )<br />

lxl304712346

请问可以用于哪方面的应用？

lea丶丶

lxl304712346 发表于 2025-9-23 16:45
请问可以用于哪方面的应用？

可以将数据保存到图元里

zhangcan0515

lxl304712346 发表于 2025-9-23 16:45
请问可以用于哪方面的应用？

可以把数据存储里边，然后在用的时候提取出来，但是这个属性CAD绘图界面是不显示的，和字典的一样的。如果扩展数据多了，DWG文件会很大。

专用车研发

图元的分解和合并好像会影响扩展数据的跟随，不知道有什么好的解决方案吗

magicheno

感谢大佬分享

llsheng_73

1. (defun getxdata(e app n / b);|app为已注册应用名,""返回图元对象的所有应用名下的数据 ，n指定返回几项，可用于强行对齐字段，nil按实际项数返回|;
   
2.      (if(and(or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))
   
3.             (not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vla-getxdata)(list e app'b'b))))b)
   
4.        (mapcar(function vlax-variant-value)(vlax-safearray->list b))
   
5.        (progn(while(<(length b)n)(setq b(cons""b)))(cons app b))))
   
6. (defun addxdatas(e doc app / apps xtype xapp);|doc,图元对象e所在文档对象，方便跨图操作或对DBX的图元对象进行处理，app(("app1" "value1""value2""value3")("app2")("app3" "a3v1""a3v2""a3v3""a3v4"))应用名后为该应用后要加入的数据,无数据的情况下去掉该应用的数据如("app2")|;
   
7.   (setq apps(vlax-get-property doc 'RegisteredApplications))
   
8.   (mapcar(function(lambda(x)(vlax-invoke-method apps 'add(car x))t))app)
   
9.   (or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))
   
10.   (setq xtype(vlax-safearray-fill(vlax-make-safearray 2'(0 . 0))'(1001))xapp(vlax-make-safearray 12'(0 . 0)))
    
11.   (vl-some(function(lambda(a / xtype n)
    
12.                      (setq n(length a)xtype(cons 1001(mapcar(function(lambda(x)(cond((=(setq x(type x))'str)1000)((= x'int)1071)((= x'real)1040))))(cdr a))))
    
13.                      (vlax-invoke-method e(function setxdata)(vlax-safearray-fill(vlax-make-safearray 2(cons 1 n))xtype)
    
14.                        (vlax-safearray-fill(vlax-make-safearray 12(cons 1 n))a))))app))

(defun getxdata(e app n / b);|app为已注册应用名,""返回图元对象的所有应用名下的数据 ，n指定返回几项，可用于强行对齐字段，nil按实际项数返回|;<br />      (if(and(or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))<br />             (not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vla-getxdata)(list e app'b'b))))b)<br />        (mapcar(function vlax-variant-value)(vlax-safearray->list b))<br />        (progn(while(<(length b)n)(setq b(cons""b)))(cons app b))))<br /> (defun addxdatas(e doc app / apps xtype xapp);|doc,图元对象e所在文档对象，方便跨图操作或对DBX的图元对象进行处理，app(("app1" "value1""value2""value3")("app2")("app3" "a3v1""a3v2""a3v3""a3v4"))应用名后为该应用后要加入的数据,无数据的情况下去掉该应用的数据如("app2")|;<br />   (setq apps(vlax-get-property doc 'RegisteredApplications))<br />   (mapcar(function(lambda(x)(vlax-invoke-method apps 'add(car x))t))app)<br />   (or(=(type e)'vla-object)(setq e(vlax-ename->vla-object e)))<br />   (setq xtype(vlax-safearray-fill(vlax-make-safearray 2'(0 . 0))'(1001))xapp(vlax-make-safearray 12'(0 . 0)))<br />   (vl-some(function(lambda(a / xtype n)<br />                      (setq n(length a)xtype(cons 1001(mapcar(function(lambda(x)(cond((=(setq x(type x))'str)1000)((= x'int)1071)((= x'real)1040))))(cdr a))))<br />                      (vlax-invoke-method e(function setxdata)(vlax-safearray-fill(vlax-make-safearray 2(cons 1 n))xtype)<br />                        (vlax-safearray-fill(vlax-make-safearray 12(cons 1 n))a))))app))