[原创]LISP表操作增强函数

hothua

;==============================================================================
;LISP中表是存储各类数据的有效方式，从其中读取值的函数较多，有：
;nth,assoc,car,cdr等，但是修改值很不方便，如果涉及到修改个数较多，
;例如排序操作，可以参考一下例子，需要掌握的函数包括set,read,eval
;==============================================================================
;  功能：开始列表处理函数
;  参数：vlist 需要进行大量修改的表，在后续操作中不能更改表的大小
;        vid   本次列表操作处理序号，是为了为能够同时进行多个列表操作
;  返回值： 列表长度
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun startvlist(vlist vid / num vnhead vn n)
  (setq num (length vlist)
  ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别
        vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_")       
        n 0       
  )
  ;记录列表长度，用以判断后续操作是否越界
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) num)
  (repeat num
    (setq vn (strcat vnhead (itoa n)))
    (set (read vn) (nth n vlist))
    (setq n (1+ n))
  ) 
)
;==============================================================================
;  功能：获取表中某个位置变量读写位置别名
;  参数：vid 同startvlist   
;        index 列表中变量序号，从0开始计数
;  返回值： 表中第index个元素存储变量名称
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun [](vid index / num vnhead) 
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  ) 
  ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别 
  (setq vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_"))
  (read (strcat vnhead (itoa index)))
)
;==============================================================================
;  功能：获取表中某个位置变量值
;  参数：vid 同startvlist     
;        index 列表中变量序号，从0开始计数
;  返回值： 表中第index个元素存储变量当前值         
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun hget(vid index / )  
  (eval ([] vid index))
)
;==============================================================================
;  功能：设置表中某个元素当前变量值
;  参数：vid 同startvlist     
;        index 列表中变量序号，从0开始计数
;        value 需要赋的值
;  返回值：新赋的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun hset(vid index value / )  
  (set ([] vid index) value)
)
;==============================================================================
;  功能：交换表中两个元素的值
;  参数：vid 同startvlist 
;        index1，index2 列表中变量序号，从0开始计数
;  返回值： 修改后index2中元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun swap(vid index1 index2 / tmpv)  
  (setq tmpv (hget vid index1))
  (hset vid index1 (hget vid index2))
  (hset vid index2 tmpv)
)
;==============================================================================
;  功能：插入一个元素
;  参数：vid 同startvlist 
;        index，插入到列表的序号，从0开始计数
;  返回值：新插入元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vinsert1(vid index value / n num tmpv)  
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (> index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (1+ num))
  (setq n num) 
  (while (> n index)
    (hset vid n (hget vid (1- n)))
    (setq n (1- n)) 
  )    
  (hset vid index value) 
)
;==============================================================================
;  功能：连续插入多个元素
;  参数：vid 同startvlist 
;        index，插入到列表的序号，从0开始计数
;        vaulelist 插入值列表。
;  返回值：新插入最后一个元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vinsert2(vid index valuelist / num num1 n)  
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")))
        num1 (length valuelist)      
  )
  (if (or (< index 0) (> index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (+ num num1)) 
  (setq n num num1 (1- num1)) 
  (while (> n index)
    (hset vid (+ n num1) (hget vid (1- n)))
    (setq n (1- n)) 
  )
  (setq n -1 index (1- index) )  
  (repeat (1+ num1)
    (setq index (1+ index)
          n (1+ n)         
    ) 
    (hset vid index (nth n valuelist))   
  ) 
)
;==============================================================================
;  功能：删除一个元素
;  参数：vid 同startvlist 
;        index，要删除列表元素的序号，从0开始计数
;  返回值：删除后表的长度
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vdelete1(vid index / num)  
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )  
  (while (< index (1- num))
    (hset vid index (hget vid (1+ index))) 
    (setq index (1+ index)) 
  ) 
  (hset vid index nil);释放变量  
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (1- num))
)
;==============================================================================
;  功能：连续删除多个元素
;  参数：vid 同startvlist 
;        index，要删除列表元素的起始序号，从0开始计数
;        dnum 要删除列表元素的个数。
;  返回值：删除后表的长度 
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vdelete2(vid index dnum / num n)  
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= (+ index dnum) num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (setq n (+ index dnum))
  (while (< n num)
    (hset vid index (hget vid n))
    (setq index (1+ index)
          n (1+ n)
    )   
  ) 
  (repeat dnum
     (hset vid index nil);释放变量 
     (setq index (1+ index))
  )  
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (- num dnum))
)
;==============================================================================
;  功能：结束列表处理函数
;  参数：num 原始vlist表长度，
;        vid 同startvlist       
;  返回值：修改后的表
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun endvlist(vid / vlist num vnhead vn n)
  (setq ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别
        vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_")
        n 0
        vlist '()
        num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")))       
  )
  (repeat num
    (setq vlist (append vlist (list (hget vid n))))
    (hset vid n nil);释放变量
    (setq n (1+ n))
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) nil)
  vlist
)
;==============================================================================
;  功能：表排序函数
;  参数：vlist 需要进行排序的表
;        vid   本次列表操作处理序号，是为了为能够同时进行多个列表操作
;        comparefun 排序函数，该函数接受两个表元素作为参数，
;                如果其返回值是nil,表示两个元素要交换位置,否则不需要
;  返回值：排序后的表
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun sortlist(vlist vid comparefun / num flag i j)
  (setq num (startvlist vlist vid)     
        i 1
        flag T
  )
  ;冒泡排序
  (while (and flag (< i num))
    (setq flag nil j (- num 2))
    (repeat (- num i)
      (if (not(comparefun (hget vid j) (hget vid (1+ j))))
        (progn
          (swap vid j (1+ j))
          (setq flag T)
        )       
      )
      (setq j (1- j))     
    )
    (setq i (1+ i))  
  ) 
  (endvlist vid)
)
;==============================================================================
;;例子，读取LWPOLYLINE线坐标，并按Y方向从大到小排序
(defun getlwcoords(en / el ptnum closeFlag points pt)
  (setq el (entget en))
  (if (not el)
    (exit)
  )
  (setq ptnum (cdr (assoc 90 el))
        closeFlag (cdr (assoc 70 el))
        points '()
  )
  (repeat ptnum
    (setq pt (cdr (assoc 10 el))
          el (cdr (member (cons 10 pt) el))
          points (append points (list pt))
    )   
  )
  points
)
(defun mycompare(pt1 pt2)
  (> (cadr pt1) (cadr pt2))
)
(defun C:test(/ ss points num n)
  (setq ss (ssget ":s" '((0 . "lwpolyline"))))
  (if (not ss)
    (exit)
  )
  (setq points (getlwcoords (ssname ss 0))
        points (sortlist points 1 mycompare)
        num (length points)
        n 0
  )
  (repeat num   
    (entmake (list '(0 . "text") (cons 10 (nth n points)) (cons 1 (itoa (setq n (1+ n))))
     '(40 . 20.0)'(41 . 0.75)))   
  )
  (princ)
)

firstinti

相当不错，收藏

zml84

(if (or (< index 0) (>= index num))

这句很别扭

jxphklibin

如何判别一个表 是否点对表呢？

vl-list-length

计算表的长度

(vl-list-length
				list-or-cons-object)

参数

list-or-cons-object

表或点对表。

返回值

如果参数是真正的表，则返回包含表长度的整数。如果 list-or-cons-object 为点对表，则返回 nil。

兼容性提示：vl-list-length 函数对点对表参数返回 nil，而相应的普通 LISP 函数的参数如果是点对表，将返回错误信息。

示例

_$ (vl-list-length nil)

0

_$ (vl-list-length '(1 2))

2

_$ (vl-list-length '(1 2 . 3))

nil

计算表的长度

(vl-list-length
		list-or-cons-object)

参数

list-or-cons-object

表或点对表。

返回值

如果参数是真正的表，则返回包含表长度的整数。如果 list-or-cons-object 为点对表，则返回 nil。

兼容性提示：vl-list-length 函数对点对表参数返回 nil，而相应的普通 LISP 函数的参数如果是点对表，将返回错误信息。

示例

_$ (vl-list-length nil)

0

_$ (vl-list-length '(1 2))

2

_$ (vl-list-length '(1 2 . 3))

nil