分享与组码 -3 有关的函数（即添加删除扩展数据xdata）删除注册扩展对象应用名

yjtdkj

参考网上找到的程序，我自己改编了一下，验证无问题后分享出来

1. (defun tt ()
   
2.   (setq appname "xapp123")
   
3.   (regapp appname)
   
4.   (setq ss (ssget))
   
5.   (setq xd (list (list -3 (list appname (cons 1000 "hhh123")))))
   
6.   (yj-AddXdata ss xd t)
   
7.   )
   
8. ;|============================================================;;
   
9. ;;;从选择中删除扩展实体数据-------------------------yjtdkj.2021.06
   
10. 参数: ss       - 要处理的选择集或图元名
    
11. 参数: xd       - 删除扩展数据的应用程序名称(不能是*或通配符)
    
12. 参数: Verbose  - 如果是 T，会显示一条消息
    
13. 返回: 未删除 Xdata 的选择集
    
14. 例子: (yj-Addxdata ss xd t)
    
15. |;
    
16. (defun yj-AddXdata  (ss xd verbose / ssl cnt ename tmp numproc numnotproc errss)
    
17.   (setq  numproc  0
    
18.   errss (ssadd)
    
19.   )
    
20.   (if (= (type ss) 'ename)
    
21.     (progn
    
22.       (setq tmp (ssadd))
    
23.       (ssadd ss tmp)
    
24.       (setq ss tmp)
    
25.     )
    
26.   )
    
27.   (if ss
    
28.     (progn
    
29.       (setq
    
30.   cnt 0
    
31.   ssl (sslength ss)
    
32.       )
    
33.       (repeat ssl
    
34.   (setq
    
35.     ename  (ssname ss cnt)
    
36.     cnt  (1+ cnt)
    
37.     oldlist (entget ename)
    
38.     newlist (append oldlist xd)
    
39.   )
    
40.   (if (entmod newlist)
    
41.     (progn
    
42.       (setq numproc (1+ numproc))
    
43.     )
    
44.     (ssadd ename errss)
    
45.   )
    
46.       )
    
47.     )
    
48.   )
    
49.   (if verbose
    
50.     (princ
    
51.       (strcat "\n Add extended entity data belonging to application "
    
52.         (itoa numproc)
    
53.         " of "
    
54.         (itoa ssl)     
    
55.       )
    
56.     )
    
57.   )
    
58.   (if (> (sslength errss) 0)
    
59.     errss
    
60.     nil
    
61.   )
    
62. )

(defun tt ()<br />   (setq appname "xapp123")<br />   (regapp appname)<br />   (setq ss (ssget))<br />   (setq xd (list (list -3 (list appname (cons 1000 "hhh123")))))<br />   (yj-AddXdata ss xd t)<br />   )<br /> ;|============================================================;;<br /> ;;;从选择中删除扩展实体数据-------------------------yjtdkj.2021.06<br /> 参数: ss       - 要处理的选择集或图元名<br /> 参数: xd       - 删除扩展数据的应用程序名称(不能是*或通配符)<br /> 参数: Verbose  - 如果是 T，会显示一条消息<br /> 返回: 未删除 Xdata 的选择集<br /> 例子: (yj-Addxdata ss xd t)<br /> |;<br /> (defun yj-AddXdata  (ss xd verbose / ssl cnt ename tmp numproc numnotproc errss)<br />   (setq  numproc  0<br />   errss (ssadd)<br />   )<br />   (if (= (type ss) 'ename)<br />     (progn<br />       (setq tmp (ssadd))<br />       (ssadd ss tmp)<br />       (setq ss tmp)<br />     )<br />   )<br />   (if ss<br />     (progn<br />       (setq<br />   cnt 0<br />   ssl (sslength ss)<br />       )<br />       (repeat ssl<br />   (setq<br />     ename  (ssname ss cnt)<br />     cnt  (1+ cnt)<br />     oldlist (entget ename)<br />     newlist (append oldlist xd)<br />   )<br />   (if (entmod newlist)<br />     (progn<br />       (setq numproc (1+ numproc)) <br />     )<br />     (ssadd ename errss)<br />   )<br />       )<br />     )<br />   )<br />   (if verbose<br />     (princ<br />       (strcat "\n Add extended entity data belonging to application "<br />         (itoa numproc)<br />         " of "<br />         (itoa ssl)     <br />       )<br />     )<br />   )<br />   (if (> (sslength errss) 0)<br />     errss<br />     nil<br />   )<br /> )

yjtdkj

1. ;|============================================================;;
   
2. ;;;从选择中删除扩展实体数据-------------------------yjtdkj.2021.06
   
3. 参数: ss       - 要处理的选择集或图元名
   
4. 参数: AppName  - 删除扩展数据的应用程序名称(不能是*或通配符)
   
5. 参数: Verbose  - 如果是 T，会显示一条消息
   
6. 返回: 未删除 Xdata 的选择集
   
7. 例子: (yj-RemoveXdata ss appname t)
   
8. |;
   
9. (defun yj-RemoveXdata (ss appname verbose / xd ssl cnt ename tmp numproc numnotproc errss)
   
10.   (setq numproc 0
    
11.         errss (ssadd)
    
12.   )
    
13.   (if (= (type ss) 'ename)
    
14.     (progn
    
15.       (setq tmp (ssadd))
    
16.       (ssadd ss tmp)
    
17.       (setq ss tmp)
    
18.     )
    
19.   )
    
20.   (if ss
    
21.     (progn
    
22.       (setq
    
23.         cnt 0
    
24.         ssl (sslength ss)
    
25.       )
    
26.       (repeat ssl
    
27.         (setq
    
28.           ename (ssname ss cnt)
    
29.           xd    (assoc -3 (entget ename (list appname)))
    
30.           cnt   (1+ cnt)
    
31.         )
    
32.         (if xd
    
33.           (progn
    
34.             (entmod (list (cons -1 ename) (list -3 (list appname))))
    
35.             (setq numproc (1+ numproc))
    
36.           )
    
37.           (ssadd ename errss)
    
38.         )
    
39.       )
    
40.     )
    
41.   )
    
42.   (if verbose
    
43.           (princ
    
44.             (strcat "\n Remove extended entity data belonging to application "
    
45.                     (itoa numproc)
    
46.                     " of "
    
47.         (itoa ssl)
    
48.             )
    
49.           )
    
50.         )
    
51.   (list (if (> (sslength errss) 0)
    
52.           errss
    
53.           nil
    
54.         )
    
55.   )
    
56. )

;|============================================================;;<br /> ;;;从选择中删除扩展实体数据-------------------------yjtdkj.2021.06<br /> 参数: ss       - 要处理的选择集或图元名<br /> 参数: AppName  - 删除扩展数据的应用程序名称(不能是*或通配符)<br /> 参数: Verbose  - 如果是 T，会显示一条消息<br /> 返回: 未删除 Xdata 的选择集<br /> 例子: (yj-RemoveXdata ss appname t)<br /> |;<br /> (defun yj-RemoveXdata (ss appname verbose / xd ssl cnt ename tmp numproc numnotproc errss)<br />   (setq numproc 0<br />         errss (ssadd)<br />   )<br />   (if (= (type ss) 'ename)<br />     (progn<br />       (setq tmp (ssadd))<br />       (ssadd ss tmp)<br />       (setq ss tmp)<br />     )<br />   )<br />   (if ss<br />     (progn<br />       (setq<br />         cnt 0<br />         ssl (sslength ss)<br />       )<br />       (repeat ssl<br />         (setq<br />           ename (ssname ss cnt)<br />           xd    (assoc -3 (entget ename (list appname)))<br />           cnt   (1+ cnt)<br />         )<br />         (if xd<br />           (progn<br />             (entmod (list (cons -1 ename) (list -3 (list appname))))<br />             (setq numproc (1+ numproc))<br />           )<br />           (ssadd ename errss)<br />         )<br />       )<br />     )<br />   )<br />   (if verbose<br />           (princ<br />             (strcat "\n Remove extended entity data belonging to application "<br />                     (itoa numproc)<br />                     " of "<br />         (itoa ssl)<br />             )<br />           )<br />         )<br />   (list (if (> (sslength errss) 0)<br />           errss<br />           nil<br />         )<br />   )<br /> )

yjtdkj

1. ;|============================================================;;
   
2. ;;;清理所有未使用的应用名-------------------------yjtdkj.2021.06
   
3. 参数: Verbose  - 如果是 T，会显示消息
   
4. 返回: 无
   
5. 例子: (yj-RemoveRegApps t)
   
6. |;
   
7. (defun yj-RemoveRegApps ( Verbose  / cnt totcnt APP_LIST)
   
8.   (setq  cnt 0
   
9.   totcnt 0
   
10.   app_list nil
    
11.   )
    
12.   (setq *acad* (vlax-get-acad-object))
    
13.   (setq *doc* (vla-get-activedocument *acad*))
    
14.   (vlax-for AppId (vla-get-registeredapplications *doc*)
    
15.     (setq totcnt (1+ totcnt))
    
16.     (if  (vl-catch-all-error-p
    
17.     (vl-catch-all-apply 'vla-delete (list AppId))
    
18.   )
    
19.       (progn (setq app_list (cons (vla-get-name AppId) app_list))
    
20.   (if Verbose
    
21.        (princ (strcat "\n"
    
22.           (vla-get-name AppId)
    
23.           " could not be deleted."
    
24.         )
    
25.        ))
    
26.       )
    
27.       (setq cnt (1+ cnt))
    
28.     )
    
29.   )
    
30.   (if Verbose
    
31.   (princ (strcat "\nDeleted "
    
32.      (itoa cnt)
    
33.      " of "
    
34.      (itoa totcnt)
    
35.      " Registered Applications."
    
36.    )
    
37.   ))
    
38.   (princ)
    
39. )

;|============================================================;;<br /> ;;;清理所有未使用的应用名-------------------------yjtdkj.2021.06<br /> 参数: Verbose  - 如果是 T，会显示消息<br /> 返回: 无<br /> 例子: (yj-RemoveRegApps t)<br /> |;<br /> (defun yj-RemoveRegApps ( Verbose  / cnt totcnt APP_LIST)<br />   (setq  cnt 0<br />   totcnt 0<br />   app_list nil<br />   )<br />   (setq *acad* (vlax-get-acad-object))<br />   (setq *doc* (vla-get-activedocument *acad*))<br />   (vlax-for AppId (vla-get-registeredapplications *doc*)<br />     (setq totcnt (1+ totcnt))<br />     (if  (vl-catch-all-error-p<br />     (vl-catch-all-apply 'vla-delete (list AppId))<br />   )<br />       (progn (setq app_list (cons (vla-get-name AppId) app_list))<br />   (if Verbose<br />        (princ (strcat "\n"<br />           (vla-get-name AppId)<br />           " could not be deleted."<br />         )<br />        ))<br />       )<br />       (setq cnt (1+ cnt))<br />     )<br />   )<br />   (if Verbose<br />   (princ (strcat "\nDeleted "<br />      (itoa cnt)<br />      " of "<br />      (itoa totcnt)<br />      " Registered Applications."<br />    )<br />   ))<br />   (princ)<br /> )

holypower2011

yjtdkj 发表于 2021-6-26 16:47

请问这个怎么用啊，有没有加载后可以直接选择删除实体xdata的？

mokson

感谢分享，很有深度的学习实例。

czb203

最近楼主高产啊，又一个大神出现了

烟花丝雨

感谢分享

轮回

感谢分享，

panliang9

谢谢楼主分享！！！

669423907

谢谢楼主分享好程序

669423907

请问各位，如何查看-3组码？