yjtdkj 发表于 2021-6-26 16:46:37

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

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

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

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

yjtdkj 发表于 2021-6-26 16:48:43

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

holypower2011 发表于 2024-7-11 15:46:14

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


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

mokson 发表于 2021-6-26 21:54:19

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

czb203 发表于 2021-6-28 19:45:25

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

烟花丝雨 发表于 2021-6-29 08:27:26

感谢分享

轮回 发表于 2021-12-28 18:38:04

感谢分享，

panliang9 发表于 2021-12-30 09:20:41

谢谢楼主分享！！！

669423907 发表于 2021-12-30 19:21:02

谢谢楼主分享好程序

669423907 发表于 2021-12-31 08:53:22

请问各位，如何查看-3组码？
页: [1] 2
查看完整版本: 分享与组码 -3 有关的函数（即添加删除扩展数据xdata）删除注册扩展对象应用名