明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 383|回复: 7

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

[复制链接]
发表于 2024-7-9 17:51 | 显示全部楼层 |阅读模式
给图元写扩展的方法如下:

  1. (defun $kuo-zhan-xie-ru$ (E      appid-value    mode
  2.         lst      /        -3data  -3-n
  3.         appid      dxf        entmod-t  xdata
  4.         xdata-old
  5.        )
  6.           ;给图元写扩展,和$kuo-zhan-du-qu$一正一反
  7.           ;E  图元名名
  8.           ;appid-value   应用名,例如:'("JB" (1071 . 529033) (1000 . "529030"))
  9.           ;mode  模式--------
  10.           ;     "DelAll" 删除所有应用名的扩展数据,不添加
  11.           ;     "Add"    不覆盖现有扩展数据,添加新的数据
  12.           ;     "Del"    删除指定应用名下的扩展数据,添加新的数据
  13.           ;     "All"    删除所有应用名下的扩展数据,添加新的数据
  14.           ;示例:($kuo-zhan-xie-ru$(CAR (ENTSEL)) '("JB" (1071 . 529033) (1000 . "529030")) "ALL")
  15.   (if (and e
  16.      (= (type E) 'ename)
  17.      (= (type appid-value) 'list)
  18.      (= (type (cdr appid-value)) 'list)
  19.      (= (type (car appid-value)) 'str)
  20.      (OR (= (type (car (car (cdr (cdr appid-value))))) 'int)
  21.          (= (type (car (cAr (cdr appid-value)))) 'int)
  22.      )
  23.      (setq appid (car appid-value))
  24.      (setq -3-n appid-value)
  25.      (setq mode (strcase mode))
  26.      (member mode
  27.        (list "DELALL" "ADD" "DEL" "ALL")
  28.      )
  29.       )
  30.     (progn
  31.       (setq dxf (entget E '("*")))  ;(SETQ E(CAR(ENTSEL)))
  32.       (SETQ -3DATA (CDR (ASSOC -3 DXF)))
  33.       (SETQ DXF (VL-REMOVE (ASSOC -3 DXF) dxf))
  34.       (COND
  35.   ((= mode "DELALL")
  36.    (SETQ XDATA
  37.     (list
  38.       (cons -1 E)
  39.       (cons -3 (mapcar 'list (mapcar 'car -3DATA)))
  40.     )
  41.    )
  42.   )
  43.   ((= mode "DEL")
  44.    (SETQ -3DATA (VL-REMOVE (ASSOC appid -3DATA) -3DATA))
  45.    (IF -3DATA
  46.      (SETQ -3DATA (APPEND -3DATA (LIST -3-n)))
  47.      (SETQ -3DATA (LIST -3-n))
  48.    )
  49.    (SETQ -3DATA (CONS -3 -3DATA))
  50.    (SETQ XDATA (APPEND DXF (LIST -3DATA)))
  51.   )
  52.   ((= mode "ADD")
  53.    (IF -3DATA
  54.      (SETQ -3DATA (APPEND -3DATA (LIST -3-n)))
  55.      (SETQ -3DATA (LIST -3-n))
  56.    )
  57.    (SETQ -3DATA (CONS -3 -3DATA))
  58.    (SETQ XDATA (APPEND DXF (LIST -3DATA)))
  59.   )
  60.   ((= mode "ALL")
  61.    (SETQ XDATA-OLD (mapcar 'list (mapcar 'car -3DATA)))
  62.    (IF XDATA-OLD
  63.      (SETQ -3DATA (APPEND XDATA-OLD (LIST -3-n)))
  64.      (SETQ -3DATA (LIST -3-n))
  65.    )
  66.    (SETQ -3DATA (CONS -3 -3DATA))
  67.    (SETQ XDATA (APPEND DXF (LIST -3DATA)))
  68.   )
  69.       )
  70.       (if
  71.   (VL-CATCH-ALL-ERROR-P
  72.     (vl-catch-all-apply
  73.       'vla-item
  74.       (LIST (vla-get-registeredapplications
  75.         (vla-get-activedocument (vlax-get-acad-object))
  76.       )
  77.       appid
  78.       )
  79.     )
  80.   )
  81.    (regapp appid)
  82.       )
  83.       (setq entmod-t (vl-catch-all-apply 'entmod (LIST XDATA)))
  84.       (if (VL-CATCH-ALL-ERROR-P entmod-t)
  85.   (print (vl-catch-all-error-message entmod-t))
  86.       )
  87.       (setq dxf (entget E '("*")))
  88.     )
  89.   )
  90.   dxf
  91. )


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

评分

参与人数 2明经币 +2 收起 理由
cchessbd + 1 很给力!但是小白不太理解,不会用这个。
dtucad + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2024-7-9 18:44 | 显示全部楼层
感谢杜总的分享!
发表于 2024-7-9 19:41 | 显示全部楼层
谢谢! dcl1214 分享学习!!!!!!
发表于 2024-7-9 22:58 | 显示全部楼层
感谢分享,支持楼主
发表于 2024-7-10 10:24 | 显示全部楼层
最后那个参数lst是多余的吧
发表于 2024-7-11 08:38 | 显示全部楼层

感谢分享,支持楼主
发表于 2024-7-12 16:35 | 显示全部楼层
给图元写扩展,和$kuo-zhan-du-qu$一正一反,$kuo-zhan-du-qu$能分享吗
 楼主| 发表于 2024-7-12 17:07 | 显示全部楼层
wzjck 发表于 2024-7-12 16:35
给图元写扩展,和$kuo-zhan-du-qu$一正一反,$kuo-zhan-du-qu$能分享吗

看看我的其他帖子
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-7-13 05:39 , Processed in 0.293784 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表