分享几个表处理函数
本帖最后由 caoyin 于 2022-10-1 12:35 编辑;;;刚刚看到网友发的表处理函数，就把自己写的分享出来，不一定好用，抛砖引玉
;;;函数以递归法居多
; ------------------------------------------------------------
;; [功能] 多维数组转三维数组
;; 用于处理VLA函数返回的点集，如IntersectWith求对象交点
;; (MD->3D '(0 1 2 3 4 5 6 7 8 9))
(defun md->3d (L)
(if (> (length L) 3)
(cons (list (car L) (cadr L) (caddr L))
(md->3d (cdddr L))
)
(list L)
)
)
;; ------------------------------------------------------------
;; [功能] 多维数组转二维数组
;; 用于处理VLA函数返回的点集，如 Coordinates 获得多段线顶点
;; (MD->2D '(0 1 2 3 4 5 6 7 8 9))
(defun md->2d (L)
(if (> (length L) 2)
(cons (list (car L) (cadr L))
(md->2d (cddr L))
)
(list L)
)
)
;; ------------------------------------------------------------
;; [功能] 三维点转换为二维点，并把数字全部转换为实数
(defun 3d->2d (L)
(mapcar '+ L '(0.0 0.0))
)
;; ------------------------------------------------------------
;; [功能] 返回表中指定项之前的部分
;; (Before 3 '(1 2.5 3 2.8 3.5 3 4 6))
(defun Before (A L / B)
(if (and (setq B (car L)) (/= A B))
(cons B (Before A (cdr L)))
)
)
;; ------------------------------------------------------------
;; [功能] 修剪掉表后面部分，从 0 到指定位置截取表
;; (Trim '(0 1 2 3 4 5 6 7 8 9) 4)->(0 1 2 3)
(defun Trim (L N)
(if (and L (/= N 0))
(cons (car L) (Trim (cdr L) (1- N)))
)
)
;; ------------------------------------------------------------
;; [功能] 返回表末端指定长度的部分
;; (ends '(0 1 2 3 4 5 6 7 8) 4)
(defun ends (L N)
(repeat (- (length L) N)
(setq L (cdr L))
)
)
;; ------------------------------------------------------------
;; [功能] 修剪掉表后面部分，从 0 到符合比较函数条件的位置截取表
;(Trim-If '(1 2.5 2.8 3.5 5 7 3 4 6) '(lambda (X) (= X 3)))
(defun Trim-If (L *F* / X)
(if (and (setq X (car L)) (not ((eval *F*) X)))
(cons X (Trim-If (cdr L) *F*))
)
)
;; ------------------------------------------------------------
;; [功能] 返回表指定位置指定长度的子项
;; (SubItems '(0 1 2 3 4 5 6 7 8 9) 2 3)
(defun SubItems (L N I)
(if (and (< N (length L)) (> I 0))
(cons (nth N L) (SubItems L (1+ N) (1- I)))
)
)
;; ------------------------------------------------------------
;; [功能] 截取表的局部
;; (Extract '(0 1 2 3 4 5 6 7 8 9) nil 8)
;; (Extract '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") "2" "8")
;; (Extract '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") "4" nil)
(defun Extract (LST ITM1 ITM2 / X)
(setq X (car LST))
(if LST
(if (or (not ITM1) (= ITM1 X))
(if (/= ITM2 X)
(cons X (Extract (cdr LST) nil ITM2))
)
(Extract (cdr LST) ITM1 ITM2)
)
)
)
;; ------------------------------------------------------------
;; [功能] 将表在指定位置断开，并返回包含两个子表的表
;; (Break '(1 2.5 2.8 3.5 5 7 3 4 6) 4)
(defun Break (L N / *F* X)
(defun *F* (L N)
(if (setq X L)
(if (/= N 0)
(cons (car X) (*F* (cdr X) (1- N)))
)
)
)
(list (*F* L N) X)
)
;; ------------------------------------------------------------
;; [功能] 按照指定长度拆分表
;; (Split '(0 1 2 3 4 5 6 7 8 9) 4)
(defun Split (L N)
(if L
(cons (car (setq L (Break L N)))
(Split (cadr L) N)
)
)
)
;; ------------------------------------------------------------
;; [功能] cdr 函数的反向操作
;; (rcdr '(1 2 3 4 5 6 7 8))
(defun rcdr (L / X)
(if (setq X (cdr L))
(cons (car L) (rcdr X))
)
)
牛啊，有些看都看不懂，但是测试真好用，哈哈，忍不住点个赞 谢谢分享，很实用的函数 多谢版主分享，学习了 多谢版主分享 多谢版主分享，学习了 谢谢! 版主分享函数!!!!
多谢版主分享 感谢版主发国庆红包 感谢版主分享 多谢版主分享
页:
[1]
2