将表的排序进行到底!!(三)全力打造最强劲的表排序函数！（现在可以下载了l...

fsxm · 发表于 2006-6-1 12:34:36

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

将排序进行到底！(1)
[B] 功能全面的通用点表排序函数！[/B]
将排序进行到底！(2)
[B] 多功能的表排序函数！
[/B] 将排序进行到底！(3)
[B] 全力打造最强劲的表排序函数！更大的可扩展性让你发现
只有你想不到没有做不到:

将排序进行到底！(3)
支持N层次表！支持自定义比较函数！[/B]
测试结果如下：

;;测试1-------------------------------------------------------
(setq lst '((10 -2)
(10 2)
(-11 3)
(-11 -3)
(12 -4)
(-13 5)
(14 -6)
)
)
;;第一项>:
(sortlist-new
lst
'("> 1")
)
;;==》
((14 -6) (12 -4) (10 -2) (10 2) (-11 3) (-11 -3) (-13 5))
;;第一项> + 第二项>:
(sortlist-new
lst
'("> 1" "> 2")
)
;;==》
((14 -6) (12 -4) (10 2) (10 -2) (-11 3) (-11 -3) (-13 5))
;;第一项绝对值>:
(sortlist-new
lst
'(">abs 1")
)
;;==》
((14 -6) (-13 5) (12 -4) (-11 3) (-11 -3) (10 -2) (10 2))
;;第一项绝对值> + 第二项绝对值<:
(sortlist-new
lst
'(">abs 1" "<abs 2")
)
;;==》
((14 -6) (-13 5) (12 -4) (-11 3) (-11 -3) (10 -2) (10 2))
;;测试2---------------------------------------------------------------------------------
(setq lst '((14 -6 "ab")
(12 -4 "abc")
(10 -2 "abcd")
(10 2 "abcde")
(-11 3 "abcdef")
(-11 -3 "xyz")
(-13 5 "你好")
)
)
;;第二项绝对值> + 第三项字符长短<:
;;先定义映射：strlen-fun可在两个中选一种方法;
(setq strlen-fun (eval '(lambda (str) (strlen str))))
(defun strlen-fun (str) (strlen str))
(sortlist-new
lst
'(">abs 2" "<strlen-fun 3")
)
;;==》
((14 -6 "ab")
(-13 5 "你好")
(12 -4 "abc")
(-11 -3 "xyz")
(-11 3 "abcdef")
(10 -2 "abcd")
(10 2 "abcde")
)
;;子表前两项和> + 第三项字符长短<:
;;先定义映射：1+2-fun strlen-fun
(defun 1+2-fun (a) (+ (car a) (cadr a)))
(sortlist-new
lst
'(">1+2-fun" "<strlen-fun 3")
)
;;测试3-----------------------------------------------------------------------------------
(setq lst '((14 -6 "ab" (1 . 5))
(12 -4 "abc" (2 . 5))
(10 -2 "abcd" (3 . 4))
(10 2 "abcde" (4 . 5))
(-11 3 "abcdef" (4 . 9))
(-11 -3 "xyz" (6 . 1))
(-13 5 "你好" (7 . 0))
)
)
;;用 t4中(t2与t1求和)> + 子表前两项和> + t4中的t1项> :
;;先定义映射：t4[1+2] 1+2-fun
(defun [1+2] (a) (+ (car (nth 3 a)) (cdr (nth 3 a))))
(sortlist-new
lst
(list ">[1+2]" ">1+2-fun" "> 4 1")
)
;;==>
((-11 3 "abcdef" (4 . 9))
(10 2 "abcde" (4 . 5))
(10 -2 "abcd" (3 . 4))
(12 -4 "abc" (2 . 5))
(-13 5 "你好" (7 . 0))
(-11 -3 "xyz" (6 . 1))
(14 -6 "ab" (1 . 5))
)

;;测试1------------------------------------------------------- 
(setq lst '((10 -2) 
            (10 2) 
            (-11 3) 
            (-11 -3) 
            (12 -4) 
            (-13 5) 
            (14 -6) 
           ) 
) 
;;第一项>: 
(sortlist-new 
  lst 
  '("> 1") 
) 
;;==》 
((14 -6) (12 -4) (10 -2) (10 2) (-11 3) (-11 -3) (-13 5)) 
;;第一项> + 第二项>: 
(sortlist-new 
  lst 
  '("> 1" "> 2") 
) 
;;==》 
((14 -6) (12 -4) (10 2) (10 -2) (-11 3) (-11 -3) (-13 5)) 
;;第一项绝对值>: 
(sortlist-new 
  lst 
  '(">abs 1") 
) 
;;==》 
((14 -6) (-13 5) (12 -4) (-11 3) (-11 -3) (10 -2) (10 2)) 
;;第一项绝对值> + 第二项绝对值<: 
(sortlist-new 
  lst 
  '(">abs 1" "<abs 2") 
) 
;;==》 
((14 -6) (-13 5) (12 -4) (-11 3) (-11 -3) (10 -2) (10 2)) 
 
 
;;测试2--------------------------------------------------------------------------------- 
 
(setq lst '((14 -6 "ab") 
            (12 -4 "abc") 
            (10 -2 "abcd") 
            (10 2 "abcde") 
            (-11 3 "abcdef") 
            (-11 -3 "xyz") 
            (-13 5 "你好") 
           ) 
) 
;;第二项绝对值>  +  第三项字符长短<: 
;;先定义映射：strlen-fun可在两个中选一种方法; 
(setq strlen-fun (eval '(lambda (str) (strlen str)))) 
(defun strlen-fun (str) (strlen str)) 
(sortlist-new 
  lst 
  '(">abs 2" "<strlen-fun 3") 
) 
;;==》 
((14 -6 "ab") 
  (-13 5 "你好") 
  (12 -4 "abc") 
  (-11 -3 "xyz") 
  (-11 3 "abcdef") 
  (10 -2 "abcd") 
  (10 2 "abcde") 
) 
 
 
;;子表前两项和>  +  第三项字符长短<: 
;;先定义映射：1+2-fun strlen-fun 
(defun 1+2-fun (a) (+ (car a) (cadr a))) 
(sortlist-new 
  lst 
  '(">1+2-fun" "<strlen-fun 3") 
) 
 
;;测试3----------------------------------------------------------------------------------- 
(setq lst '((14 -6 "ab" (1 . 5)) 
            (12 -4 "abc" (2 . 5)) 
            (10 -2 "abcd" (3 . 4)) 
            (10 2 "abcde" (4 . 5)) 
            (-11 3 "abcdef" (4 . 9)) 
            (-11 -3 "xyz" (6 . 1)) 
            (-13 5 "你好" (7 . 0)) 
           ) 
) 
;;用 t4中(t2与t1求和)> + 子表前两项和> + t4中的t1项> : 
;;先定义映射：t4[1+2] 1+2-fun 
(defun [1+2] (a) (+ (car (nth 3 a)) (cdr (nth 3 a)))) 
(sortlist-new 
  lst 
  (list ">[1+2]" ">1+2-fun" "> 4 1") 
) 
;;==> 
((-11 3 "abcdef" (4 . 9)) 
  (10 2 "abcde" (4 . 5)) 
  (10 -2 "abcd" (3 . 4)) 
  (12 -4 "abc" (2 . 5)) 
  (-13 5 "你好" (7 . 0)) 
  (-11 -3 "xyz" (6 . 1)) 
  (14 -6 "ab" (1 . 5)) 
)

fsxm · 发表于 2006-6-1 15:55:43

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如果有什么问题请随时指教!
欢迎提出反例!
看看本函数能不能达到预期目标:
[B]对所有复杂的表进行排序![/B]

vang8866 · 发表于 2006-6-1 16:57:06

下一个

不是吧什么都没有老大。。。。。白下了还要币

fsxm · 发表于 2006-6-1 18:02:29

不知道为什么第一次没传上去！：(大小:0.00 KB,4次下载)
4位朋友对不起了！
重新传上了！这个.fas的测试用不要币了！
如果用的可以再下源程序好了！
并请各位老大出表我来用这个函数来排序以验证它的通用性！
大家可以用.fas的去测试的！

WHGF · 发表于 2006-6-2 13:18:58

还是等你把LISP放上来吧，对于一些特殊要求还是自己做好些

fsxm · 发表于 2006-6-2 14:07:45

WHGF 老兄我的lsp早就放上去了啊！·
在一楼呢！！名叫sortlist（3）的就是了啦！

m00ner · 发表于 2006-6-3 23:53:11

好像不能下啊？？？

fsxm · 发表于 2006-6-4 09:46:26

i 不会吧？
真的不能下吗？？？

我试过了完全可以下载的！
老大们请不要误导消费者好不好啦？？
要不我真的一个币都捞不到了啦！~~！
这样好了！如果真的有不能下载的
请留下QQ号发到你的QQ邮箱里！

雨箭风刀 · 发表于 2006-6-4 11:10:21

能否对点对第二项排序？

fsxm · 发表于 2006-6-4 11:18:32

没有不可以的东东··请出表
上面的测试有：
[php]
(setq lst '((14 -6 "ab")
 (12 -4 "abc")
 (10 -2 "abcd")
 (10 2 "abcde")
 (-11 3 "abcdef")
 (-11 -3 "xyz")
 (-13 5 "你好")
 )
)
;;第二项绝对值> + 第三项字符长短<:
;;先定义映射：strlen-fun可在两个中选一种方法;
(setq strlen-fun (eval '(lambda (str) (strlen str))))
(defun strlen-fun (str) (strlen str))
(sortlist-new
 lst
 '(">abs 2" "<strlen-fun 3")
)
[/php]

雨箭风刀 · 发表于 2006-6-4 19:43:05

我说的是
'((0 (a . 2) (0 (b . 1))(0 (c . 0)))
中的 2 1 0

wujimmy · 发表于 2006-6-4 21:40:32

排序不是有现成的函数:

;;;排序
(setq listzxjd (vl-sort listzxjd
(function (lambda (e1 e2)
(if (< (abs(- (car e1) (car e2))) wjm_Y_diet );_如果X坐标相等,则按照Y坐标排列
(< (cadr e1) (cadr e2))
(< (car e1) (car e2))
)
)
)
)
)

语法

 (vl-sort list comparison-function)

功能

 根据给定的比较函数来对表中的元素排序。

说明

1）参数 list 为任意表。

2）comparison-function 为比较函数。可以是任何一个这样的函数：接受如下两个参数，若第一个参数按排序顺序在第二个元素之前，则返回 T 或非 nil 值。comparison-function 的值可以采用如下格式：

。符号 (函数名)

。'(LAMBDA (L1 L2) ...)

。(FUNCTION (LAMBDA (L1 L2) ...))

返回值：

表，其中包含 list 中的元素，这些元素按照 comparison-function 中指定的顺序排列。该表可能删除了重复的元素。

样例：

1）对数值表排序：

_$ (vl-sort '(3 2 1 3) '>)

( 3 2 1 ) ;

2）按 Y 坐标对二维点表排序：

(vl-sort '((3 5) (2 2) (4 3))

 (function (lambda (e1 e2)

 (< (cadr e1) (cadr e2)) ) ) )

((2 2) (4 3) (3 5))

3）对符号表排序：

_$ (vl-sort

'(a d c h b a)

'(lambda (s1 s2)

 (< (vl-symbol-name s1) (vl-symbol-name s2)) ) )

(A B C D H) ; 请注意在结果表中仅有一个 A

fsxm · 发表于 2006-6-5 08:02:40

雨箭风刀:
[php]
(setq a
 '(
 (0 (a . 2))
 (0 (b . 1))
 (0 (c . 0))
 (0 (d . 3))
)
)
;你说的用T2中的T2排列.
;定义映射:
(defun cdrx (x) (cdr x))
;从小到大
(sortlist-new a (list "<cdrx 2"))
;从大到小
(sortlist-new a (list ">cdrx 2"))
[/php]

wujimmy :
vl-sort 是基础排序函数!功能是不可挑战的！
以至于几乎所有的排序函数都少不了它了.
只是有时对复杂的表排序用起来很烦!

yxh1202 · 发表于 2013-6-2 10:21:39

(defun sort-pt-1 (plts fun n)

 (vl-sort plts

 '(lambda (a b)

 (fun (nth n a) (nth n b))

 )

 )

)

(defun sort-pt (plst xyz / fun)

 (setq xyz (vl-string->list xyz))

 (foreach n-xyz (reverse xyz)

(if (< n-xyz 100)

 (setq fun >

 n-xyz (- n-xyz 88)

 plst (sort-pt-1 plst fun n-xyz)

 )

 (setq fun <

 n-xyz (- n-xyz 120)

 plst (sort-pt-1 plst fun n-xyz)

 )

)

 )

)

;-------------------------------------------------
(defun C:hdm (/ S1 S2 I)
 (setq en (entsel "选择一条直线:"))
;(setq size 0.1)
 (SETQ S1 (ssget '((0 . "POINT"))))
 (SETQ n 0)

 (repeat (sslength s1)
(setq lst (cons (ssname s1 n) lst)
 n (1+ n)
)
 )

 (setq
x (mapcar '(lambda (x) (car (cdr (assoc 10 (entget x))))) lst)
 )

 (setq
y (mapcar '(lambda (x) (cadr (cdr (assoc 10 (entget x)))))
 lst
 )
 )

 (setq maxx (eval (cons 'max x))
minx (eval (cons 'min x))
 )
 (setq maxy (eval (cons 'max y))
miny (eval (cons 'min y))
 )
 (setq dx (- maxx minx)
dy (- maxy miny)
 )
 (if (> dx dy)
;;x坐标排序：
(setq S2 (sort-pt-1 s1 "x" n))
;;y坐标排序：
(setq S2 (sort-pt-1 s1 "y" n))
 )
 (progn
(setq I 0)
(repeat (sslength S2)
 (setq pen_data (entget (ssname s2 i)))
 (setq ppt (assoc 10 pen_data))
 (setq pp (cdr ppt))
 (setq Perpt (vlax-curve-getClosestPointTo (car en) pp T))
;找出垂点
 (entmake (APPEND '((0 . "LINE")
 (100 . "AcDbEntity")
 (100 . "AcDbLine")
 (8 . "0")
)
 (LIST (CONS 10 pp) (CONS 11 perpt))

 )
 )
 (princ "\n")
 (princ (cdddr (assoc 10 (entget (ssname S2 I)))))
;显示排序结果。
 (setq I (1+ I))
)
 )

 (princ)
)
为何提示参数错误呢

GTJ116600 · 发表于 2013-6-25 17:33:22

飞诗的表排序函数，留印学习

账号		自动登录	找回密码
密码			立即注册

[原创] 将表的排序进行到底!!(三)全力打造最强劲的表排序函数！（现在可以下载了l...

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子