明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 76242|回复: 616

[源码] 点表排序、图元坐标点排序-----通吃-----再浓缩----最终版2014.2.22

    [复制链接]
发表于 2013-9-6 14:29 | 显示全部楼层 |阅读模式
本帖最后由 自贡黄明儒 于 2014-3-22 13:43 编辑

;;最终版
;;*****************************************************************************通用点表排序
;|本软件为开源软件: 以下是开源申明:                                             
-----------------------------------------------------------------------------------------------;
本页面的软件遵照GPL协议开放源代码,您可以自由传播和修改,在遵照下面的约束条件的前提下:
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明,保持此许可证的声明和没有担保的声明完
整无损,并和程序一起给每个其他的程序接受者一份许可证的副本,你就可以用任何媒体复制和发布你收到的
原始的程序的源代码。你也可以为转让副本的实际行动收取一定费用,但必须事先得到的同意。
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分,以此形成基于程序的作品。只要你同时满足
下面的所有条件,你就可以按前面第一款的要求复制和发布这一经过修改的程序或作品。   
1.你必须在修改的文件中附有明确的说明: 你修改了这一文件及具体的修改日期。   
2.你必须使你发布或出版的作品(它包含程序的全部或一部分,或包含由程序的全部或部分衍生的作品)允许
  第三方作为整体按许可证条款免费使用。        
3.如果修改的程序在运行时以交互方式读取命令,你必须使它在开始进入常规的交互使用方式时打印或显示声
  明: 包括适当的版权声明和没有担保的声明(或者你提供担保的声明);用户可以按此许可证条款重新发布
  程序的说明;并告诉用户如何看到这一许可证的副本。(例外的情况: 如果原始程序以交互方式工作,它并
  不打印这样的声明,你的基于程序的作品也就不用打印声明。
三. 只要你遵循一、二条款规定,您就可以自由使用并传播本源代码,但必须原封不动地保留原作者信息。|;
;;ssPts: 1 选择集,返回图元列表
;;           2 点表(1到n维 1维时key只能是x或X),返回点表
;;          3 图元列表,返回图元列表
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先,小y表示从小到大(注:二维点时,不能有z)
;;FUZZ: 允许误差
;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
;;示例4 (HH:ssPts:Sort (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A")
;;示例5 (HH:ssPts:Sort (list 5 8 5 9) "X" 1)=>(9 8 5)
;;本程序是在fsxm的扩展 自贡黄明儒 2014年3月22日
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N)
  ;;1 点列表排序
  (defun sortpts (PTS FUN xyz FUZZ)
    (vl-sort pts
             '(lambda (a b)
                (if (not (equal (xyz a) (xyz b) fuzz))
                  (fun (xyz a) (xyz b))
                )
              )
    )
  )
  ;;2 排序
  (defun sortpts1 (PTS KEY FUZZ)
    (setq Key (vl-string->list Key))
    (foreach xyz (reverse Key)
      (cond ((< xyz 100)
             (setq fun >)
             (setq xyz (nth (- xyz 88) (list car cadr caddr)))
            )
            (T
             (setq fun <)
             (setq xyz (nth (- xyz 120) (list car cadr caddr)))
            )
      )
      (setq Pts (sortpts Pts fun xyz fuzz))
    )
  )
  ;;3 本程序主程序
  (cond
    ((= (type ssPts) 'PICKSET)
     (repeat (setq n (sslength ssPts))
       (if (and        (setq e (ssname ssPts (setq n (1- n))))
                (setq en (entget e))
           )
         (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
       )
     )
     (mapcar 'last (sortpts1 lst KEY FUZZ))
    )
    ((Listp ssPts)
      (cond
        ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
        ((= (type (car ssPts)) 'ENAME)
         (foreach e ssPts
           (if (setq en (entget e))
             (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
           )
         )
         (mapcar 'last (sortpts1 lst KEY FUZZ))
        )
        (T
         (cond ((equal key "X") (vl-sort ssPts '>))
               (T (vl-sort ssPts '<))
         )
        )
      )
    )   
  )
)
;;*****************************************************************************通用点表排序


;;再浓缩 自贡黄明儒 2013年9月9日

  1. ;;ssPts: 1 选择集,返回图元列表
  2. ;;    2 点表(1到n维 1维时key只能是x或X),返回点表
  3. ;;   3 图元列表,返回图元列表
  4. ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先,小y表示从小到大(注:二维点时,不能有z)
  5. ;;FUZZ: 允许误差
  6. ;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
  7. ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
  8. ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
  9. ;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
  10. ;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
  11. ;;*****************************************************************************通用点表排序
  12. 本软件为开源软件: 以下是开源申明:                                             
  13. -----------------------------------------------------------------------------------------------;
  14. 本页面的软件遵照GPL协议开放源代码,您可以自由传播和修改,在遵照下面的约束条件的前提下:   
  15.             
  16. 一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明,保持此许可证的声明和没有担保的声明完
  17. 整无损,并和程序一起给每个其他的程序接受者一份许可证的副本,你就可以用任何媒体复制和发布你收到的
  18. 原始的程序的源代码。你也可以为转让副本的实际行动收取一定费用,但必须事先得到的同意。  
  19.                   
  20. 二. 你可以修改本开源软件的一个或几个副本或程序的任何部分,以此形成基于程序的作品。只要你同时满足
  21. 下面的所有条件,你就可以按前面第一款的要求复制和发布这一经过修改的程序或作品。   
  22. 1.你必须在修改的文件中附有明确的说明: 你修改了这一文件及具体的修改日期。   
  23. 2.你必须使你发布或出版的作品(它包含程序的全部或一部分,或包含由程序的全部或部分衍生的作品)允许
  24.   第三方作为整体按许可证条款免费使用。        
  25. 3.如果修改的程序在运行时以交互方式读取命令,你必须使它在开始进入常规的交互使用方式时打印或显示声
  26.   明: 包括适当的版权声明和没有担保的声明(或者你提供担保的声明);用户可以按此许可证条款重新发布
  27.   程序的说明;并告诉用户如何看到这一许可证的副本。(例外的情况: 如果原始程序以交互方式工作,它并
  28.   不打印这样的声明,你的基于程序的作品也就不用打印声明。                  
  29.             
  30. 三. 只要你遵循一、二条款规定,您就可以自由使用并传播本源代码,但必须原封不动地保留原作者信息。  
  31. ;;ssPts: 1 选择集,返回图元列表
  32. ;;    2 点表(1到n维 1维时key只能是x或X),返回点表
  33. ;;   3 图元列表,返回图元列表
  34. ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先,小y表示从小到大(注:二维点时,不能有z)
  35. ;;FUZZ: 允许误差
  36. ;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
  37. ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
  38. ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
  39. ;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
  40. ;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
  41. (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
  42.   ;;1 点列表排序
  43.   (defun sortpts (PTS FUN xyz FUZZ)
  44.     (vl-sort pts
  45.       '(lambda (a b)
  46.   (if (not (equal (xyz a) (xyz b) fuzz))
  47.     (fun (xyz a) (xyz b))
  48.   )
  49.        )
  50.     )
  51.   )
  52.   ;;2 排序
  53.   (defun sortpts1 (PTS KEY FUZZ)
  54.     (setq Key (vl-string->list Key))
  55.     (foreach xyz (reverse Key)
  56.       (cond ((< xyz 100)
  57.       (setq fun >)
  58.       (setq xyz (nth (- xyz 88) (list car cadr caddr)))
  59.      )
  60.      (T
  61.       (setq fun <)
  62.       (setq xyz (nth (- xyz 120) (list car cadr caddr)))
  63.      )
  64.       )
  65.       (setq Pts (sortpts Pts fun xyz fuzz))
  66.     )
  67.   )
  68.   ;;3 本程序主程序
  69.   (cond ((= (type ssPts) 'PICKSET)
  70.   (repeat (setq n (sslength ssPts))
  71.     (if (and (setq e (ssname ssPts (setq n (1- n))))
  72.       (setq en (entget e))
  73.         )
  74.       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
  75.     )
  76.   )
  77.   (mapcar 'last (sortpts1 lst KEY FUZZ))
  78. )
  79. ((Listp ssPts)
  80.   (cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
  81.         ((= (type (car ssPts)) 'ENAME)
  82.   (foreach e ssPts
  83.     (if (setq en (entget e))        
  84.       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
  85.     )
  86.   )
  87.   (mapcar 'last (sortpts1 lst KEY FUZZ))
  88.         )
  89.   )
  90. )
  91.   )
  92. )
  93. ;;*****************************************************************************通用点表排序
===========================================================================

时间:2013年9月6日
  1. ;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月6日
  2. ;;ssPts: 1 选择集,返回图元列表
  3. ;;  2 点表(1到n维 1维时key只能是x或X),返回点表
  4. ;;  3 (cons 点表 A)组成的列表,返回A组成的列表
  5. ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先,小y表示从小到大(注:二维点时,不能有z)
  6. ;;FUZZ: 允许误差
  7. ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
  8. ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
  9. ;;示例3 (((-597.321 2418.69 0.0) . <Entity name: 7ef7b418>) ((-597.321 2411.69 0.0) . <Entity name: 7ef7b400>));返回(<Entity name: 7ef7b418> <Entity name: 7ef7b400>)
  10. (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
  11.   ;;1 点列表排序
  12.   (defun sortpts (PTS FUN F FUZZ)
  13.     (vl-sort pts
  14.       '(lambda (a b)
  15.   (if (not (equal (F a) (F b) fuzz))
  16.     (fun (F a) (F b))
  17.   )
  18.        )
  19.     )
  20.   )
  21.   ;;2 选择集图元排序
  22.   (defun sortSS (PTS FUN F FUZZ)
  23.     (vl-sort pts
  24.       '(lambda (a b)
  25.   (if (not (equal (F (car a)) (F (car b)) fuzz))
  26.     (fun (F (car a)) (F (car b)))
  27.   )
  28.        )
  29.     )
  30.   )
  31.   ;;3 排序
  32.   (defun sortSS1 (myfun PTS KEY FUZZ)
  33.     (setq Key (vl-string->list Key))
  34.     (foreach xyz (reverse Key)
  35.       (cond ((< xyz 100)
  36.       (setq fun >)
  37.       (setq xyz (nth (- xyz 88) (list car cadr caddr)))
  38.      )
  39.      (T
  40.       (setq fun <)
  41.       (setq xyz (nth (- xyz 120) (list car cadr caddr)))
  42.      )
  43.       )
  44.       (setq Pts (myfun Pts fun xyz fuzz))
  45.     )
  46.   )
  47.   ;;4 本程序主程序
  48.   (cond ((= (type ssPts) 'PICKSET)
  49.   (repeat (setq n (sslength ssPts))
  50.     (if (and (setq e (ssname ssPts (setq n (1- n))))
  51.       (setq en (entget e))
  52.         )
  53.       (setq lst (cons (cons (cdr (assoc 10 en)) e) lst))
  54.     )
  55.   )
  56.   (mapcar 'cdr (sortSS1 sortSS lst KEY FUZZ))
  57. )
  58. (T
  59.   (cond
  60.     ((= (type (caar ssPts)) 'LIST)
  61.      (mapcar 'cdr (sortSS1 sortSS ssPts KEY FUZZ))
  62.     )
  63.     (T (sortSS1 sortpts ssPts KEY FUZZ))
  64.   )
  65. )
  66.   )
  67. )

评分

参与人数 5明经币 +5 金钱 +30 收起 理由
hubeiwdlue + 1 很给力!
飞雪神光 + 1 很给力!
Bao_lai + 1 很给力!
xshrimp + 1 + 30 很给力!
wayne_myles + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2022-8-15 17:28 | 显示全部楼层
引用了,这个太强大了!
回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2024-4-1 09:48 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2024-4-1 11:02 编辑
纵横八方 发表于 2024-3-30 17:04
点个赞,再加上 往返排序 8式 就完美了

;;x弓形排序
(defun C:t1 ()
  (setq L nil)
  (setq ss (ssget))
  ;;Y从大到小,X从大到小
  (setq L1 (HH:ssPts:Sort ss "YX" 0.1))

  (while L1
    ;;取最上一排
    (setq e (car L1));右上角
    (setq L1 (HH:ssPts:Sort L1 "Yx" 0.1))
    (while (and        (setq a (car L1))
                (setq L (cons a L))
                (setq L1 (cdr L1))               
                (not (equal a e))
           )
    )
    ;;左上角第一个
    (setq e (car L1));左上角
    (setq L1 (HH:ssPts:Sort L1 "YX" 0.1))
    (while (and        (setq a (car L1))
                (setq L (cons a L))
                (setq L1 (cdr L1))               
                (not (equal a e))
           )      
    )   
  )
  (setq L (reverse L))

  ;;验证
  (setq n 0)
  (foreach x L
    (setq n (1+ n))
    (entmod (append (entget x) (list (cons 1 (itoa n)))))
  )
)

发表于 2023-8-7 00:45 | 显示全部楼层
函数是以组码10为基准对图元进行排序,其实这里可以再增加一个取点函数,使程序的通用性更强。
这样就可以做到:以图元的中心点为基准排序、以图元包围框的左下角点为基准排序等效果。
发表于 2013-9-6 14:33 | 显示全部楼层
看一下都要币呀,没币的人很悲催了!

点评

其实明经币没什么用,主要针对只下载而不发贴的  发表于 2013-9-6 14:44
发表于 2013-9-6 14:35 | 显示全部楼层
看看有没钱

点评

很多人都写过点表排序,我也写过,唯一这个是通用的,不容易哟。  发表于 2013-9-6 14:46
 楼主| 发表于 2013-9-6 14:50 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2014-3-22 10:09 编辑

;;应用示例

  1. ;;自定义Max(可以是字母例表)
  2. (defun MyMax (lst) (car (HH:ssPts:Sort lst "X" 1)))
发表于 2013-9-6 15:06 | 显示全部楼层
老黄写的不错,大小写是个好想法

点评

fsxm的  发表于 2013-9-6 20:18
发表于 2013-9-6 15:09 | 显示全部楼层
有更详细的介绍吗?  感觉很好的样子。
 楼主| 发表于 2013-9-6 15:11 | 显示全部楼层
yzxgwl 发表于 2013-9-6 15:09
有更详细的介绍吗?  感觉很好的样子。

;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月6日
;;ssPts: 1 选择集,返回图元列表
;;  2 点表(1到n维 1维时key只能是x或X),返回点表
;;  3 (cons 点表 A)组成的列表,返回A组成的列表
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先,小y表示从小到大(注:二维点时,不能有z)
;;FUZZ: 允许误差
;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
;;示例3 (((-597.321 2418.69 0.0) . <Entity name: 7ef7b418>) ((-597.321 2411.69 0.0) . <Entity name: 7ef7b400>));返回(<Entity name: 7ef7b418> <Entity name: 7ef7b400>)
发表于 2013-9-6 19:11 | 显示全部楼层
楼主最起码来个GIF格式的图片演示吧

点评

不需要,也无法演示  发表于 2013-9-10 13:34
发表于 2013-9-6 19:41 | 显示全部楼层
老黄写的不错,大小写是个好想法

点评

fsxm的想法!!  发表于 2013-9-6 20:17
发表于 2013-9-7 12:12 | 显示全部楼层
大儒的程序,一定要顶啊。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-25 17:37 , Processed in 0.612766 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表