块分解后如何写入扩展数据

yhly555

存在问题：dwg图中红色块分解后如何写入扩展数据，白色块分解后却不能，不知道为什么？请高手帮忙，谢谢！

2. ;存在问题：dwg图中红色块分解后可以写入扩展数据，白色块分解后却不能，不知道为什么？请高手帮忙，谢谢！
   
3. 
   
4. (defun c:bn ()  
   
5.   (setq ss (ssget '((0 . "INSERT"))) Index 0)
   
6.   (repeat (sslength ss)
   
7.     (setq Ename (ssname ss Index))
   
8.     (setq Index (1+ Index))
   
9.     (command "_EXPLODE" Ename)
   
10.     (princ (entlast))
    
11.     (TTEDIT (entlast) "AAA" (cons 1000 "写入的扩展数据" ) "ALL")      ;地块标志符
    
12.   )  
    
13. )
    
14. 
    
15. (vl-load-com)
    
16. ;;;=============================================
    
17. ;;;      通用函数   扩展数据的添加              
    
18. ;;;参数：en       ----  对象图元名              
    
19. ;;;      app_name ----扩展应用名               
    
20. ;;;      v1       ----值                        
    
21. ;;;      STR      ----操作标识。含义如下：
    
22. ;;;                       "DelOnly"删除指定应用名的扩展数据，不添加
    
23. ;;;                       "DelAll" 删除所有应用名的扩展数据，不添加
    
24. ;;;                       "Add"    不覆盖现有扩展数据，添加新的数据
    
25. ;;;                       "Del"    删除指定应用名下的扩展数据，添加新的数据
    
26. ;;;                       "All"    删除所有应用名下的扩展数据，添加新的数据
    
27. ;;;日期：zml84 修改于 2013-07-18
    
28. (defun TTEDIT (EN APP_NAME V1 STR / ENL TMP TMP1 TMP2)
    
29.   ;;转换为大写
    
30.   (setq STR (strcase STR))
    
31.   ;;
    
32.   (cond
    
33.     ;;1.删除指定应用名的扩展数据
    
34.     ((= STR "DELONLY")
    
35.       (setq ENL (entget EN (list APP_NAME)))
    
36.       (if (assoc -3 ENL)
    
37.         (entmod (subst (list -3 (list APP_NAME)) (assoc -3 ENL) ENL)
    
38.         )
    
39.       )
    
40.     )
    
41.     ;;2.删除原来所有的扩展数据
    
42.     ((or (= STR "DELALL")
    
43.         (= STR "ALLDEL")
    
44.       )
    
45.       (setq ENL (entget EN (list "*")))
    
46.       (setq TMP (cdr (assoc -3 ENL)))
    
47.       ;;逐个删除
    
48.       (foreach N TMP
    
49.         (TTEDIT EN (car N) NIL "DELONLY")
    
50.       )
    
51.     )
    
52.     ;;3.不操作任何扩展数据（如果注册的是已有的也不覆盖）
    
53.     ((or (= STR "ADD")
    
54.         (= STR "")
    
55.       )
    
56.       (setq ENL (entget EN (list APP_NAME)))
    
57.       (setq TMP (cdr (assoc -3 ENL)))
    
58.       (setq TMP1 (cdr (assoc APP_NAME TMP)))
    
59.       (if TMP1
    
60.         (setq TMP2  (append TMP1 (list V1))
    
61.           ENL  (subst (list -3 (cons APP_NAME TMP2)) (assoc -3 ENL) ENL)
    
62.         )
    
63.         (setq ENL (append ENL (list (list -3 (list APP_NAME V1)))))
    
64.       )
    
65.       
    
66.       (regapp APP_NAME);;更新
    
67.       (entmod ENL)
    
68.     )
    
69.    
    
70.     ((= STR "DEL");;4.删除当前，添加新的数据      
    
71.       (TTEDIT EN APP_NAME NIL "DELONLY");;删除原来所有的扩展数据      
    
72.       (TTEDIT EN APP_NAME V1 "ADD");;添加新的数据
    
73.     )   
    
74.     ((= STR "ALL");;5.删除原来所有的扩展数据，添加新的数据      
    
75.       (TTEDIT EN NIL NIL "DELALL");;删除原来所有的扩展数据      
    
76.       (TTEDIT EN APP_NAME V1 "ADD");;添加新的数据
    
77.     )   
    
78.   ) ;_结束COND
    
79. )

;存在问题：dwg图中红色块分解后可以写入扩展数据，白色块分解后却不能，不知道为什么？请高手帮忙，谢谢！<br /> <br /> (defun c:bn ()  <br />   (setq ss (ssget '((0 . "INSERT"))) Index 0)<br />   (repeat (sslength ss)<br />     (setq Ename (ssname ss Index))<br />     (setq Index (1+ Index))<br />     (command "_EXPLODE" Ename)<br />     (princ (entlast))<br />     (TTEDIT (entlast) "AAA" (cons 1000 "写入的扩展数据" ) "ALL")      ;地块标志符<br />   )  <br /> )<br /> <br /> (vl-load-com)<br /> ;;;=============================================<br /> ;;;      通用函数   扩展数据的添加              <br /> ;;;参数：en       ----  对象图元名              <br /> ;;;      app_name ----扩展应用名                <br /> ;;;      v1       ----值                        <br /> ;;;      STR      ----操作标识。含义如下：<br /> ;;;                       "DelOnly"删除指定应用名的扩展数据，不添加<br /> ;;;                       "DelAll" 删除所有应用名的扩展数据，不添加<br /> ;;;                       "Add"    不覆盖现有扩展数据，添加新的数据<br /> ;;;                       "Del"    删除指定应用名下的扩展数据，添加新的数据<br /> ;;;                       "All"    删除所有应用名下的扩展数据，添加新的数据<br /> ;;;日期：zml84 修改于 2013-07-18 <br /> (defun TTEDIT (EN APP_NAME V1 STR / ENL TMP TMP1 TMP2)<br />   ;;转换为大写<br />   (setq STR (strcase STR))<br />   ;;<br />   (cond<br />     ;;1.删除指定应用名的扩展数据<br />     ((= STR "DELONLY")<br />       (setq ENL (entget EN (list APP_NAME)))<br />       (if (assoc -3 ENL)<br />         (entmod (subst (list -3 (list APP_NAME)) (assoc -3 ENL) ENL)<br />         )<br />       )<br />     )<br />     ;;2.删除原来所有的扩展数据<br />     ((or (= STR "DELALL")<br />         (= STR "ALLDEL")<br />       )<br />       (setq ENL (entget EN (list "*")))<br />       (setq TMP (cdr (assoc -3 ENL)))<br />       ;;逐个删除<br />       (foreach N TMP<br />         (TTEDIT EN (car N) NIL "DELONLY")<br />       )<br />     )<br />     ;;3.不操作任何扩展数据（如果注册的是已有的也不覆盖）<br />     ((or (= STR "ADD")<br />         (= STR "")<br />       )<br />       (setq ENL (entget EN (list APP_NAME)))<br />       (setq TMP (cdr (assoc -3 ENL)))<br />       (setq TMP1 (cdr (assoc APP_NAME TMP)))<br />       (if TMP1<br />         (setq TMP2  (append TMP1 (list V1))<br />           ENL  (subst (list -3 (cons APP_NAME TMP2)) (assoc -3 ENL) ENL)<br />         )<br />         (setq ENL (append ENL (list (list -3 (list APP_NAME V1)))))<br />       )<br />       <br />       (regapp APP_NAME);;更新<br />       (entmod ENL)<br />     )<br />     <br />     ((= STR "DEL");;4.删除当前，添加新的数据      <br />       (TTEDIT EN APP_NAME NIL "DELONLY");;删除原来所有的扩展数据      <br />       (TTEDIT EN APP_NAME V1 "ADD");;添加新的数据<br />     )    <br />     ((= STR "ALL");;5.删除原来所有的扩展数据，添加新的数据      <br />       (TTEDIT EN NIL NIL "DELALL");;删除原来所有的扩展数据      <br />       (TTEDIT EN APP_NAME V1 "ADD");;添加新的数据<br />     )    <br />   ) ;_结束COND<br /> )