图元写扩展以及entget指定扩展的方法

dcl1214 · 发表于 2024-7-9 17:51:16

给图元写扩展的方法如下：

(defun $kuo-zhan-xie-ru$ (E appid-value mode
lst / -3data -3-n
appid dxf entmod-t xdata
xdata-old
)
;给图元写扩展，和$kuo-zhan-du-qu$一正一反
;E 图元名名
;appid-value 应用名，例如：'("JB" (1071 . 529033) (1000 . "529030"))
;mode 模式--------
; "DelAll" 删除所有应用名的扩展数据，不添加
; "Add" 不覆盖现有扩展数据，添加新的数据
; "Del" 删除指定应用名下的扩展数据，添加新的数据
; "All" 删除所有应用名下的扩展数据，添加新的数据
;示例：($kuo-zhan-xie-ru$(CAR (ENTSEL)) '("JB" (1071 . 529033) (1000 . "529030")) "ALL")
(if (and e
(= (type E) 'ename)
(= (type appid-value) 'list)
(= (type (cdr appid-value)) 'list)
(= (type (car appid-value)) 'str)
(OR (= (type (car (car (cdr (cdr appid-value))))) 'int)
(= (type (car (cAr (cdr appid-value)))) 'int)
)
(setq appid (car appid-value))
(setq -3-n appid-value)
(setq mode (strcase mode))
(member mode
(list "DELALL" "ADD" "DEL" "ALL")
)
)
(progn
(setq dxf (entget E '("*"))) ;(SETQ E(CAR(ENTSEL)))
(SETQ -3DATA (CDR (ASSOC -3 DXF)))
(SETQ DXF (VL-REMOVE (ASSOC -3 DXF) dxf))
(COND
((= mode "DELALL")
(SETQ XDATA
(list
(cons -1 E)
(cons -3 (mapcar 'list (mapcar 'car -3DATA)))
)
)
)
((= mode "DEL")
(SETQ -3DATA (VL-REMOVE (ASSOC appid -3DATA) -3DATA))
(IF -3DATA
(SETQ -3DATA (APPEND -3DATA (LIST -3-n)))
(SETQ -3DATA (LIST -3-n))
)
(SETQ -3DATA (CONS -3 -3DATA))
(SETQ XDATA (APPEND DXF (LIST -3DATA)))
)
((= mode "ADD")
(IF -3DATA
(SETQ -3DATA (APPEND -3DATA (LIST -3-n)))
(SETQ -3DATA (LIST -3-n))
)
(SETQ -3DATA (CONS -3 -3DATA))
(SETQ XDATA (APPEND DXF (LIST -3DATA)))
)
((= mode "ALL")
(SETQ XDATA-OLD (mapcar 'list (mapcar 'car -3DATA)))
(IF XDATA-OLD
(SETQ -3DATA (APPEND XDATA-OLD (LIST -3-n)))
(SETQ -3DATA (LIST -3-n))
)
(SETQ -3DATA (CONS -3 -3DATA))
(SETQ XDATA (APPEND DXF (LIST -3DATA)))
)
)
(if
(VL-CATCH-ALL-ERROR-P
(vl-catch-all-apply
'vla-item
(LIST (vla-get-registeredapplications
(vla-get-activedocument (vlax-get-acad-object))
)
appid
)
)
)
(regapp appid)
)
(setq entmod-t (vl-catch-all-apply 'entmod (LIST XDATA)))
(if (VL-CATCH-ALL-ERROR-P entmod-t)
(print (vl-catch-all-error-message entmod-t))
)
(setq dxf (entget E '("*")))
)
)
dxf
)

(defun $kuo-zhan-xie-ru$ (E      appid-value    mode 
        lst      /        -3data  -3-n 
        appid      dxf        entmod-t  xdata 
        xdata-old 
       ) 
          ;给图元写扩展，和$kuo-zhan-du-qu$一正一反 
          ;E  图元名名 
          ;appid-value   应用名，例如：'("JB" (1071 . 529033) (1000 . "529030")) 
          ;mode  模式-------- 
          ;     "DelAll" 删除所有应用名的扩展数据，不添加 
          ;     "Add"    不覆盖现有扩展数据，添加新的数据 
          ;     "Del"    删除指定应用名下的扩展数据，添加新的数据 
          ;     "All"    删除所有应用名下的扩展数据，添加新的数据 
          ;示例：($kuo-zhan-xie-ru$(CAR (ENTSEL)) '("JB" (1071 . 529033) (1000 . "529030")) "ALL") 
  (if (and e 
     (= (type E) 'ename) 
     (= (type appid-value) 'list) 
     (= (type (cdr appid-value)) 'list) 
     (= (type (car appid-value)) 'str) 
     (OR (= (type (car (car (cdr (cdr appid-value))))) 'int) 
         (= (type (car (cAr (cdr appid-value)))) 'int) 
     ) 
     (setq appid (car appid-value)) 
     (setq -3-n appid-value) 
     (setq mode (strcase mode)) 
     (member mode 
       (list "DELALL" "ADD" "DEL" "ALL") 
     ) 
      ) 
    (progn 
      (setq dxf (entget E '("*")))  ;(SETQ E(CAR(ENTSEL))) 
      (SETQ -3DATA (CDR (ASSOC -3 DXF))) 
      (SETQ DXF (VL-REMOVE (ASSOC -3 DXF) dxf)) 
      (COND 
  ((= mode "DELALL") 
   (SETQ XDATA 
    (list 
      (cons -1 E) 
      (cons -3 (mapcar 'list (mapcar 'car -3DATA))) 
    ) 
   ) 
  ) 
  ((= mode "DEL") 
   (SETQ -3DATA (VL-REMOVE (ASSOC appid -3DATA) -3DATA)) 
   (IF -3DATA 
     (SETQ -3DATA (APPEND -3DATA (LIST -3-n))) 
     (SETQ -3DATA (LIST -3-n)) 
   ) 
   (SETQ -3DATA (CONS -3 -3DATA)) 
   (SETQ XDATA (APPEND DXF (LIST -3DATA))) 
  ) 
  ((= mode "ADD") 
   (IF -3DATA 
     (SETQ -3DATA (APPEND -3DATA (LIST -3-n))) 
     (SETQ -3DATA (LIST -3-n)) 
   ) 
   (SETQ -3DATA (CONS -3 -3DATA)) 
   (SETQ XDATA (APPEND DXF (LIST -3DATA))) 
  ) 
  ((= mode "ALL") 
   (SETQ XDATA-OLD (mapcar 'list (mapcar 'car -3DATA))) 
   (IF XDATA-OLD 
     (SETQ -3DATA (APPEND XDATA-OLD (LIST -3-n))) 
     (SETQ -3DATA (LIST -3-n)) 
   ) 
   (SETQ -3DATA (CONS -3 -3DATA)) 
   (SETQ XDATA (APPEND DXF (LIST -3DATA))) 
  ) 
      ) 
      (if 
  (VL-CATCH-ALL-ERROR-P 
    (vl-catch-all-apply 
      'vla-item 
      (LIST (vla-get-registeredapplications 
        (vla-get-activedocument (vlax-get-acad-object)) 
      ) 
      appid 
      ) 
    ) 
  ) 
   (regapp appid) 
      ) 
      (setq entmod-t (vl-catch-all-apply 'entmod (LIST XDATA))) 
      (if (VL-CATCH-ALL-ERROR-P entmod-t) 
  (print (vl-catch-all-error-message entmod-t)) 
      ) 
      (setq dxf (entget E '("*"))) 
    ) 
  ) 
  dxf 
)

entget获取dxf的时候，指定扩展名的方法：
(setq dxf (entget (car(entsel "请点击图元获取扩展祖玛")) (list "jb")))

dcl1214 · 发表于 2024-7-12 17:07:47

wzjck 发表于 2024-7-12 16:35
给图元写扩展，和$kuo-zhan-du-qu$一正一反,$kuo-zhan-du-qu$能分享吗

看看我的其他帖子

wzjck · 发表于 2024-7-12 16:35:54

给图元写扩展，和$kuo-zhan-du-qu$一正一反,$kuo-zhan-du-qu$能分享吗

烟盒迷唇 · 发表于 2024-7-10 10:24:18

最后那个参数lst是多余的吧

guosheyang · 发表于 2024-7-9 18:44:45

感谢杜总的分享！

yoyoho · 发表于 2024-7-9 19:41:29

谢谢! dcl1214 分享学习!!!!!!

paulpipi · 发表于 2024-7-9 22:58:13

感谢分享，支持楼主

chenhuixo · 发表于 2024-7-11 08:38:02

感谢分享，支持楼主

czb203 · 发表于 2024-7-15 10:05:41

大佬最近高产，感谢热心分享

喀麦隆村长 · 发表于 2024-7-15 16:14:54

感谢分享，支持楼主

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

[源码] 图元写扩展以及entget指定扩展的方法

评分