分享几个表处理函数

caoyin

;;;刚刚看到网友发的表处理函数，就把自己写的分享出来，不一定好用，抛砖引玉

;;;函数以递归法居多


; ------------------------------------------------------------
;; [功能] 多维数组转三维数组
;; 用于处理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))
  )
)

韩飞翔

牛啊，有些看都看不懂，但是测试真好用，哈哈，忍不住点个赞

gdfyhao

谢谢分享，很实用的函数

行天下

多谢版主分享，学习了

dtucad

多谢版主分享

hhh454

多谢版主分享，学习了

yoyoho

谢谢! 版主分享函数!!!!

lxl217114

多谢版主分享

Dea25

感谢版主发国庆红包

caoliu023

感谢版主分享

229096767

多谢版主分享