字典在 VLisp 中的应用

最新推荐文章于 2022-08-23 20:50:49 发布

yxp_xa

最新推荐文章于 2022-08-23 20:50:49 发布

阅读量3.4k

点赞数 4

分类专栏： VisualLisp ActiveX 文章标签：字典 LISP activex

本文链接：https://blog.csdn.net/yxp_xa/article/details/72228819

版权

VisualLisp 同时被 2 个专栏收录

6 篇文章 11 订阅

订阅专栏

ActiveX

5 篇文章 1 订阅

订阅专栏

此处的 “字典”作为一种自动化的 ActiveX 对象，对应链接库文件为 scrrun.dll，在 Windows 系统内已默认注册，适用于 32/64 位系统。

字典对象是一种优化过的特殊数组，使用时不需声明固定长度，可自由增加数据。本文将字典对象引入 VLisp 语言，避开 Lisp 对超长表操作的效率低下问题。

以下代码在 64 位系统 Windows10 调试通过。

一、创建字典对象

(setq ob (vlax-create-object "Scripting.Dictionary"))

如果成功将返回一个 object 对象，下面将列出该对象的属性和方法

(vlax-dump-object ob t)

如果 ob 对象创建成功，则返回以下属性和方法：

;特性值:
;   CompareMode = 0
;   Count (RO) = 0
;   Item = ...不显示带索引的内容...
;   Item (RO) = ...不显示带索引的内容...
;   Key (RO) = ...不显示带索引的内容...
;支持的方法:
;   Add (2)
;   Exists (1)
;   Items ()
;   Keys ()
;   Remove (1)
;   RemoveAll ()

VisualLisp 的对象操作函数和 AutoLisp 函数稍有区别，对属性或方法的操作，并不依赖返回值，操作成功时返回 nil.

二、字典对象的属性

字典的属性有 4 个：CompareMode 属性、Count 属性、Item 属性、Key 属性。相当于建立一个 (Key Item) 的二维数组，每个关键字对应一个 Item 属性，Item 属性很灵活，可以是数值或文本类型，也可以是数组或字典类型（嵌套字典）。此关键字在字典对象中唯一存在，类似 Lisp 表对结构，但 Lisp 表对 (a . b) 的第一项没有唯一性。

1. CompareMode 属性

设置字典对象中进行字符串关键字比较时所使用的模式，可以使用的值是 0 (二进制)、1 (文本), 2 (数据库)。默认为 0
在文本模式下，关键字的比较不分大小写，即 “AA” 和 “aa” 将被认为是同一个关键字。注意：如果试图改变一个已经包含有数据的字典对象的比较模式，那么将导致一个错误。

(vlax-get-property ob 'CompareMode)
(vlax-put-property ob 'CompareMode 1)

2. Count 属性

获取字典内项目的个数，返回一个整数，如果字典为空，则返回 0，该属性为只读。

(vlax-get-property ob "count")

3. Item 属性

(1)获取指定关键字 “abc” 的项，如果关键字不存在，将返回一个未初始化的对象

(vlax-get-property ob 'Item "abc")

返回字典关键字对应项目为 Lisp 数据，可用自定义函数

(defun d_Item(d KEY)(vlax-variant-value (vlax-get-property d 'Item KEY)))

(2)给关键字 “abc” 指定一个项，如果关键字不存在，则创建；如果存在，则改写关键字的项，这个属性保证了关键字唯一性。

(vlax-put-property ob 'Item "abc" 66)

4. Key 属性

修改一个关键字的名称，如果旧关键字不存在，或者新关键字已经存在，都将返回一个错误。

(vlax-put-property ob 'key "abc" "ddd")

三、字典对象的方法

字典对象的方法有6个：Add 方法、Keys 方法、Items 方法、Exists 方法、Remove 方法、RemoveAll 方法。

1. Add 方法

给字典添加关键字 “abc” 值为 22，如果 “abc” 已存在，将返回一个错误。所以用 add 方法添加关键字前，需要先查找该关键字是否存在。用字典对象的 Item 属性来添加关键字时，不存在则添加，存在则改写。

(vlax-invoke-method ob "ADD" "abc" 22)

2. Keys 方法

返回字典关键字的一维对象数组，使用时需要先转为数组值，再转为 list 表

(vlax-invoke-method ob 'Keys)

3. Items 方法

返回字典项目的一维对象数组

(vlax-invoke-method ob 'Items)

将一维数组转为为 List 表可用以下自定义函数，调用:

(d_LKI d 'Keys) 或 (d_LKI d 'Items)
(defun d_LKI(d k)
(mapcar 'vlax-variant-value (vlax-safearray->list 
    (vlax-variant-value (vlax-invoke-method d k))))
)

4. Exists 方法

查询关键字 “abc” 是否存在，如果存在返回 :vlax-true，不存在则返回 :vlax-false

(vlax-invoke-method ob 'Exists "abc")

5. Remove 方法

从字典中清除一个关键字。如果 “abc” 不存在，将返回一个错误。

(vlax-invoke-method ob 'Remove "abc")

6. RemoveAll 方法

删除字典对象中所有关键字

(vlax-invoke-method ob 'RemoveAll)

四、字典对象的应用

例1. 去掉重复值问题
由于字典中 key 值的唯一性，这个问题用字典解决非常合适。
加载通用子函数 d_Item、d_LtKI：

(defun d_Item(d k)(vlax-variant-value (vlax-get-property d 'Item k)))
(defun d_LtKI(d k)(mapcar 'vlax-variant-value 
(vlax-safearray->list (vlax-variant-value (vlax-invoke-method d k)))))
(setq L '("abc" "中国" "长城" "陕西" "中国" "北京" "abc" "a")) ;;准备数据

代码如下：

(defun d-DelSame(L / A L1)
    (setq d (vlax-create-object "Scripting.Dictionary"))
    (while (setq A (car L))
        (vlax-put-property d 'Item A "")
        (setq L (cdr L))
    )
    (setq L1 (d_LtKI d "Keys"))
    (vlax-release-object d)
L1
)

去除重复元素一般用递归算法，但是对于超长表，可能会出现堆栈溢出错误。

(defun delsame (L)(if L (cons (car L)(delsame (vl-remove (car L) L)))))

两种方法效率测试如下，测试平台 AutoCAD 2012 x64、Inter core i7-6700
当表长度为 100 时，字典耗时 0.004 秒，递归耗时 0.001 秒
当表长度为 1000 时，字典耗时 0.009 秒，递归耗时 0.041 秒
当表长度为 5000 时，字典耗时 0.054 秒，递归耗时 2.016 秒
当表长度为 10000时，字典耗时 0.106 秒，递归函数已经溢出了，导致 CAD 崩溃。
结论：当表长度在100以下时，用递归方法效率很高；达到1000以上时不建议用递归；超过5000时，绝对不要用递归。

测试函数：

(defun test(n / AA)
    (setq i 0 AA '())
    (while (< i n) (setq AA (cons (setq i (1+ i)) AA)))
    (setq time0 (getvar "date"))
    (d-DelSame AA)
    (setq time1 (getvar "date"))
    (delsame AA)
    (setq time2 (getvar "date"))
    (princ (strcat "\n字典方法耗时: " (rtos (* 86400 (- time1 time0)) 2 4) " 秒"))
    (princ (strcat "\n递归方法耗时: " (rtos (* 86400 (- time2 time1)) 2 4) " 秒"))
(princ)
)

例2. 求重复值个数问题
以下代码返回统计重复元素后的二维表

(defun d-SameSum(L / A L1)
    (setq d (vlax-create-object "Scripting.Dictionary"))
    (while (setq A (car L))
        (or (setq sum (d_Item d A)) (setq sum 0))
        (vlax-put-property d 'Item A (1+ sum))
        (setq L (cdr L))
    )
    (setq L1 (mapcar 'list (d_LtKI d "Keys")(d_LtKI d "Items")))
    (vlax-release-object d)
L1
)