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

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

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

(defun $kuo-zhan-xie-ru$ (E      appid-value    mode
      lst      /      -3data-3-n
      appid      dxf      entmod-txdata
      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

感谢分享，支持楼主
页: [1] 2
查看完整版本: 图元写扩展以及entget指定扩展的方法