[LISP函数]：移出指定名称XDATA

eachy

2. 
   
3. ;|
   
4. e -- entity appname --- regapp name
   
5. |;
   
6. (defun xd-xdata_remove (e appname)
   
7.   (setq        ed  (entget e (list appname))
   
8.         old (assoc -3 ed)
   
9.         new (list -3 (list appname))
   
10.         ed  (subst new old ed)
    
11.   )
    
12.   (entmod ed)
    
13. )

<br /> ;|<br /> e -- entity appname --- regapp name<br /> |;<br /> (defun xd-xdata_remove (e appname)<br />   (setq        ed  (entget e (list appname))<br />         old (assoc -3 ed)<br />         new (list -3 (list appname))<br />         ed  (subst new old ed)<br />   )<br />   (entmod ed)<br /> )

狂刀

其实有更简便的写法

2. 
   
3.   [FONT=courier new]
   
4. ;| 删除实体扩展数据单个项目.--ok--by 狂刀.2004.10
   
5. 实例:
   
6. (xd-remove e "xx")
   
7. |;
   
8. (defun xd-remove (e app)
   
9.   (entmod (list (cons -1 e)(list -3 (list app))))
   
10. )
    
11.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;| 删除实体扩展数据单个项目.--ok--by 狂刀.2004.10<br /> 实例:<br /> (xd-remove e "xx")<br /> |;<br /> (defun xd-remove (e app)<br />   (entmod (list (cons -1 e)(list -3 (list app))))<br /> )<br />   [/FONT]<br />

2. 
   
3.   [FONT=courier new]
   
4. ;| 删除实体扩展数据单个或多个项目.--ok--by 狂刀.2004.10
   
5. 实例:
   
6. (xd-xremove e "xx")
   
7. (xd-xremove e '("xx" "xd"))
   
8. |;
   
9. (defun xd-xremove (e apps)
   
10.   (if(not(listp apps))(setq apps(list apps)))
    
11.   (entmod (list (cons -1 e)(list -3 (mapcar 'list apps))))
    
12. )
    
13.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;| 删除实体扩展数据单个或多个项目.--ok--by 狂刀.2004.10<br /> 实例:<br /> (xd-xremove e "xx")<br /> (xd-xremove e '("xx" "xd"))<br /> |;<br /> (defun xd-xremove (e apps)<br />   (if(not(listp apps))(setq apps(list apps)))<br />   (entmod (list (cons -1 e)(list -3 (mapcar 'list apps))))<br /> )<br />   [/FONT]<br />

2. 
   
3.   [FONT=courier new]
   
4. ;; 删除实体所有扩展数据项目.--ok--by 狂刀.2004.10
   
5. ;; 实例: (xd-clean e)
   
6. (defun xd-clean (e)
   
7.   (entmod (list (cons -1 e)(list -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))
   
8. )
   
9. ;;或:
   
10. (xd-xremove e (mapcar 'car (cdr(list -3 (entget e '("*"))))))
    
11.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;; 删除实体所有扩展数据项目.--ok--by 狂刀.2004.10<br /> ;; 实例: (xd-clean e)<br /> (defun xd-clean (e)<br />   (entmod (list (cons -1 e)(list -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))<br /> )<br /> ;;或:<br /> (xd-xremove e (mapcar 'car (cdr(list -3 (entget e '("*"))))))<br />   [/FONT]<br />

wmz_0211

2楼楼主,你这个好像不行:
(defun xd-remove (e app)
  (entmod (list (cons -1 e)(cons -3 (list app))))
)

狂刀

怎么不行？请说明

wmz_0211

最初由 wmz_0211 发布
[B]2楼楼主,你这个好像不行:
(defun xd-remove (e app)
  (entmod (list (cons -1 e)(cons -3 (list app))))
) [/B]

执行后显示DXF组码错误!

狂刀

谢谢指出，程序中 cons应为list，已经修改。

aeo

最初由 狂刀 发布
[B]其实有更简便的写法
;| 删除实体扩展数据单个或多个项目.--ok--by 狂刀.2004.10
实例:
(xd-xremove e "xx")
(xd-xremove e '("xx" "xd"))
|;
(defun xd-xremove (e apps)
  (if(not(listp apps))(setq apps(list apps)))
  (entmod (list (cons -1 e)(list -3 (mapcar 'list apps))))
)
[/B]

其实关键所在是:如果apps里包含有没注册的,或者这个实体没有的扩展，将会出错.
判断不应该写在外面，因为我有判断的时间，早就可以把它删了.

狂刀

那个if不是用来判断是否已经注册的，而是判断是原子还是表。如果是原子则删除一个，如果是表则删除多个。
注册名应该是已知的，这个是前提，否则就没有意义