多选删除扩展数据

panliang9 · 发表于 2015-1-26 11:02

带扩展数据的图元一旦放进块中，很多时候会出现“参照丢失，无法编辑”的情况，很是恼火！

找了一个删除扩展数据的程序，能用，但是只能一个一个对象的选择，不能框选，多选，下面是我找到的程序，

尊敬的版主大人，还有路过的各位高手，能不能帮我改一下，使它能够框选多选直接删除呢！

(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
)
)
)

附件内是我需要删除扩展数元数据的样例图形！

大家帮帮我！

flytoday · 发表于 2015-1-26 15:19

;;版权申明: 本程序由 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)
  )

ziyouwzb · 发表于 2023-10-24 10:25

非常使用，感谢分享。

panliang9 · 发表于 2015-1-26 11:06

这是一个国外的贴子，贴子中提到使用宏来删除，也给出了代码，但我没能成功加载，

惭愧！

贴子地址：
http://forums.autodesk.com/t5/vi ... ta-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))
)
)
)

; 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)) 
) 
) 
)

panliang9 · 发表于 2015-1-26 11:25

在这个贴子里找到一个删除当前图的所有扩展图元的程序：

可以用，但是还是没有找到框选删除的！

;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)
)

panliang9 · 发表于 2015-1-26 11:26

这是上面的贴子地址：

http://forums.autodesk.com/t5/vi ... ta-clean/m-p/812935

panliang9 · 发表于 2015-1-26 11:33

这个程序按它的描述，似乎就是我需要的，但不会用！

;; | ----------------------------------------------------------------------------
;; | 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)
)

;; | ---------------------------------------------------------------------------- 
;; | 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 12:28

快过年了，大家都去采购年货去了吗？都没人理我的！

springwillow · 发表于 2015-1-26 14:20

panliang9 发表于 2015-1-26 11:25
在这个贴子里找到一个删除当前图的所有扩展图元的程序：

可以用，但是还是没有找到框选删除的！

这个代码里的daa不就是删除图里所有对象的扩展数据的吗？想框选的就把ssget后的X去掉就可以了啊。

panliang9 · 发表于 2015-1-26 15:59

谢谢 “flytoday”！

太感谢了！这就是我需要的！

我前面也搜了一下版里，没想到G版已经写出我需要的东西了！

非常开心！

panliang9 · 发表于 2015-1-26 16:00

也谢谢 “springwillow”！

谢谢你的指点！我真是什么都不懂呢！

账号		自动登录	找回密码
密码			注册

[已解答] 多选删除扩展数据

本帖子中包含更多资源

本帖被以下淘专辑推荐:

本帖子中包含更多资源