多选删除扩展数据
带扩展数据的图元一旦放进块中，很多时候会出现“参照丢失，无法编辑”的情况，很是恼火！找了一个删除扩展数据的程序，能用，但是只能一个一个对象的选择，不能框选，多选，下面是我找到的程序，
尊敬的版主大人，还有路过的各位高手，能不能帮我改一下，使它能够框选多选直接删除呢！(defun c:DelXdata()
(setq l (car (entsel "Pick object:")))
(if l (progn
(redraw l 3)
(setq le (entget l '("*")) )
(setq xdata (assoc '-3 le))
(setq le
(subst (cons (car xdata) (list (list (car (car (cdr xdata)))))) xdata le))
(entmod le)
(redraw l 4)
le
)
)
)附件内是我需要删除扩展数元数据的样例图形！
大家帮帮我！
;;版权申明: 本程序由 Gu_xl 开发,版权归属Gu_xl,请勿将本程序用于商业目的
;;*********************************************************************
(defun c:tt(/ ss en enl xdl n)
(princ "\n**选择要删除扩展数据的物体**")
(while (setq ss (ssget))
;; 删除全部扩展数据
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n)))
enl (entget en '("*"))
xdl (cdr (assoc -3 enl))
)
(if xdl
(progn
(setq xdl
(cons -3 (mapcar '(lambda (x) (list (car x))) xdl)))
(entmod (cons xdl (entget en)))
)
)
)
(princ "\n**继续选择要删除扩展数据的物体**")
)
(princ)
)
非常使用，感谢分享。 这是一个国外的贴子，贴子中提到使用宏来删除，也给出了代码，但我没能成功加载，
惭愧！
贴子地址：
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/xdata-clean/m-p/812935; thanks to Jurge Menzi and Tony Tanzillo
; Use:
; (DDP_del_all_prm '("MyApp1" "MyApp2")) ;delete by AppID's
; or
; (DDP_del_all_prm '("*")) ;delete all
; The argument of the function should be a list. This allows you to
; delete Xdata's with different AppID's.
(defun DDP_del_all_prm (Apps / apps_str CurEnt CurSet EntCnt app_name)
(setq apps_str "")
(foreach app_name Apps
(setq apps_str (strcat apps_str "," app_name))
)
(cond
( (setq CurSet (ssget (list (list -3 (list (substr apps_str 2))))))
(repeat (setq EntCnt (sslength CurSet))
(setq EntCnt (1- EntCnt)
CurEnt (ssname CurSet EntCnt)
)
(DelXdata CurEnt Apps)
(if (= "INSERT" (DXF 0 (entget CurEnt)))
(while
(= "ATTRIB" (DXF 0 (entget (setq CurEnt (entnext CurEnt)))))
(DelXdata CurEnt Apps)
)
)
);repeat
(princ "\nEliminazione Xdata eseguita. ")
)
(T (princ "\nNessun oggetto con Xdata. ") )
)
)
(defun DelXdata (Ent Apps / EntLst TmpLst)
(setq EntLst (entget Ent Apps))
(if
(and
(eq "DIMENSION" (DXF 0 EntLst))
(not (DXF -3 (entget Ent '("ACAD"))))
(= 14 (atoi (getvar "ACADVER")))
)
(entmod (list (cons -1 Ent) (cons -3 '(("ACAD" (1000 . "DSTYLE"))))))
)
(foreach memb (DXF -3 EntLst)
(setq
TmpLst (cons -3 (list (cons (car memb) nil)))
EntLst (entmod (subst TmpLst (assoc -3 EntLst) EntLst))
)
)
) 在这个贴子里找到一个删除当前图的所有扩展图元的程序：
可以用，但是还是没有找到框选删除的！;Delete all Xdata fom a object:
;delallxdata
(defun DelXdata (ent app / entlst tmplst)
(setq entlst (entget ent app))
(foreach memb (cdr (assoc -3 entlst))
(setq tmplst (cons -3 (list (cons (car memb) nil)))
entlst (subst tmplst (assoc -3 entlst) entlst)
entlst (entmod entlst)
)
)
)
(defun C:dss ( / curent)
(if (setq curent (car (entsel "\nSelect object to remove Xdata: ")))
(DelXdata curent '("*")) ;->see below
)
(princ)
)
(defun C:daa ( / curass countr)
(setq curass (ssget "X" '((-3 ("*"))))
countr 0
)
(if curass
(repeat (sslength curass)
(DelXdata (ssname curass countr) '("*"))
(setq countr (1+ countr))
)
)
(princ)
) 这是上面的贴子地址：
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/xdata-clean/m-p/812935 这个程序按它的描述，似乎就是我需要的，但不会用！;; | ----------------------------------------------------------------------------
;; | XD_remxd
;; | ----------------------------------------------------------------------------
;; | Function : removes extended entity data from selection
;; | Arguments:
;; | 'ss' - Selection set to process
;; | 'AppName' - Application Name to remove Xdata (cannot be * or
;; | wildcards)
;; | 'Verbose' - If T, a message is displayed while deleting
;; | Action : Checks for extended entity data and removes them
;; | Returns: The selection set and number of objects whose Xdata was removed,
;; | as well as the number of objects ignored.
;; | Updated: March 19, 1999
;; | e-mail : rakesh.rao@4d-technologies.com
;; | Web : www.4d-technologies.com
;; | ----------------------------------------------------------------------------
(defun XD_RemXd (ss AppName Verbose / xd ssl cnt ename tmp NumProc NumNotProc RemSS)
(setq
NumProc 0
NumNotProc 0
RemSS (ssadd)
)
(if (= (type ss) 'ENAME)
(progn
(setq tmp (ssadd))
(ssadd ss tmp)
(setq ss tmp)
))
(if ss
(progn
(setq
cnt 0
ssl (sslength ss)
tmp (strcat " of " (itoa ssl))
)
(if Verbose (princ "\n"))
(repeat ssl
(setq
ename (ssname ss cnt)
xd (assoc -3 (entget ename (list AppName)))
cnt (1+ cnt)
)
(if xd
(progn
(entmod (list (cons -1 ename) (list -3 (list AppName))))
(setq NumProc (1+ NumProc))
(ssadd ename RemSS)
)
(setq NumNotProc (1+ NumNotProc))
)
(if Verbose
(princ (strcat "\rRemoving extended entity data belonging to application " AppName "..." (itoa cnt) tmp))
)
)
))
(list (if (> (sslength RemSS) 0) RemSS nil) NumProc NumNotProc)
)
快过年了，大家都去采购年货去了吗？都没人理我的！ panliang9 发表于 2015-1-26 11:25 static/image/common/back.gif
在这个贴子里找到一个删除当前图的所有扩展图元的程序：
可以用，但是还是没有找到框选删除的！
这个代码里的daa不就是删除图里所有对象的扩展数据的吗？想框选的就把ssget后的X去掉就可以了啊。 谢谢 “flytoday”！
太感谢了！这就是我需要的！
我前面也搜了一下版里，没想到G版已经写出我需要的东西了！
非常开心！ 也谢谢 “springwillow”！
谢谢你的指点！我真是什么都不懂呢！
页:
[1]
2