【视频】动态DCL 之扩展数据查看，新增过滤器设置

vitalgg

动态DCL 之扩展数据查看. 小试 vscode 写 lisp.

新增过滤器设置，可以先设置过滤器，选择自己需要的扩展数据。

源码已更新，见下面的网址
源码： https://gitee.com/atlisp/packages/tree/main/at-xdata

1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
2. ;; 这是使用开发工具 dev-tools 自动创建的程序源文件
   
3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
4. ;; 定义配置项 'at-xdata:first 用于 应用包 at-xdata 的 第一个配置项 first
   
5. ;; (@:get-config 'at-xdata:first) ;; 获取配置顶的值
   
6. ;; (@:set-config 'at-xdata:first  "新设的值") ;; 设置配置顶的值
   
7. ;; 向系统中添加菜单
   
8. (@:add-menu "扩展数据管理" "查询扩展数据" '(at-xdata:browser))
   
9. (defun at-xdata:browser ()
   
10.   (setq ss-x (ssget "x" '((-3 ("*")))))
    
11.   (@:log "INFO" (strcat "发现了" (itoa (sslength ss-x)) "个有扩展数据的图元"))
    
12.   (setq order-ent 0)
    
13.   (if (setq current (ssname ss-x order-ent))
    
14.     (progn
    
15.       (pickset:zoom current)
    
16.       (sssetfirst nil (ssadd current))))
    
17.   (dcl:dialog "xdata")
    
18.   (dcl:mtext "xdata" 8 50)
    
19.   (dcl:button "next" "Next" "")
    
20.   (dcl:dialog-end-ok-cancel)
    
21.   (defun gen-mtext ()
    
22.     (strcat "第 "(itoa (1+ order-ent))" 个，共 "(itoa (sslength ss-x))" 个\n"
    
23.       "图元类型:"(entity:getdxf current 0) "\n"
    
24.       (if (wcmatch (entity:getdxf current 0) "INSERT")
    
25.         (strcat "名称:" (block:get-effectivename current) "\n")
    
26.         "")
    
27.       "扩展数据\n"
    
28.       (string:from-list
    
29.         (mapcar
    
30.           '(lambda (x)
    
31.              (strcat "APPID:" (car x)"\n"
    
32.                (vl-prin1-to-string (cdr x))))
    
33.           (cdr (assoc -3 (entget current '("*")))))"\n")))
    
34.   (defun cb-next (/ current)
    
35.     (setq order-ent (1+ order-ent))
    
36.     (if (>= order-ent (sslength ss-x))
    
37.       (setq order-ent 0))
    
38.     (if (setq current (ssname ss-x order-ent))
    
39.       (progn
    
40.         (pickset:zoom current)
    
41.         (dcl:set-mtext "xdata" (gen-mtext))
    
42.         (sssetfirst nil (ssadd current)))
    
43.       (setq order 0)))
    
44.   (dcl:new "xdata")
    
45.   (dcl:set-mtext "xdata" (gen-mtext))
    
46.   (set_tile "title" "扩展数据查看")
    
47.   (dcl:show)
    
48.   (princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;; 这是使用开发<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a> dev-tools 自动创建的程序源文件 <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;; 定义配置项 'at-xdata:first 用于 应用包 at-xdata 的 第一个配置项 first <br /> ;; (@:get-config 'at-xdata:first) ;; 获取配置顶的值<br /> ;; (@:set-config 'at-xdata:first  "新设的值") ;; 设置配置顶的值<br /> ;; 向系统中添加菜单 <br /> (@:add-menu "扩展数据管理" "查询扩展数据" '(at-xdata:browser))<br /> (defun at-xdata:browser () <br />   (setq ss-x (ssget "x" '((-3 ("*")))))<br />   (@:log "INFO" (strcat "发现了" (itoa (sslength ss-x)) "个有扩展数据的图元"))<br />   (setq order-ent 0)<br />   (if (setq current (ssname ss-x order-ent)) <br />     (progn <br />       (pickset:zoom current)<br />       (sssetfirst nil (ssadd current))))<br />   (dcl:dialog "xdata")<br />   (dcl:mtext "xdata" 8 50)<br />   (dcl:button "next" "Next" "")<br />   (dcl:dialog-end-ok-cancel)<br />   (defun gen-mtext () <br />     (strcat "第 "(itoa (1+ order-ent))" 个，共 "(itoa (sslength ss-x))" 个\n"<br />       "图元类型:"(entity:getdxf current 0) "\n"<br />       (if (wcmatch (entity:getdxf current 0) "INSERT") <br />         (strcat "名称:" (block:get-effectivename current) "\n")<br />         "")<br />       "扩展数据\n"<br />       (string:from-list <br />         (mapcar <br />           '(lambda (x) <br />              (strcat "APPID:" (car x)"\n"<br />                (vl-prin1-to-string (cdr x))))<br />           (cdr (assoc -3 (entget current '("*")))))"\n")))<br />   (defun cb-next (/ current) <br />     (setq order-ent (1+ order-ent))<br />     (if (>= order-ent (sslength ss-x)) <br />       (setq order-ent 0))<br />     (if (setq current (ssname ss-x order-ent)) <br />       (progn <br />         (pickset:zoom current)<br />         (dcl:set-mtext "xdata" (gen-mtext))<br />         (sssetfirst nil (ssadd current)))<br />       (setq order 0)))<br />   (dcl:new "xdata")<br />   (dcl:set-mtext "xdata" (gen-mtext))<br />   (set_tile "title" "扩展数据查看")<br />   (dcl:show)<br />   (princ))

新增过滤器设置：




代码截图：


效果图：



视频：

如果无法播放，请点击此处在新窗口打开

htxhtx

怎么加载啊

vitalgg

htxhtx 发表于 2023-8-3 17:00
怎么加载啊

签名里的网址

https://atlisp.cn