点表排序、图元坐标点排序-----通吃-----再浓缩----最终版2014.2.22
本帖最后由 自贡黄明儒 于 2014-3-22 13:43 编辑;;最终版
**** Hidden Message *****
;;再浓缩 自贡黄明儒 2013年9月9日
;;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)
;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
;;*****************************************************************************通用点表排序
本软件为开源软件: 以下是开源申明:
-----------------------------------------------------------------------------------------------;
本页面的软件遵照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)
;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
;;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))
)
)
)
)
)
;;*****************************************************************************通用点表排序
===========================================================================
时间:2013年9月6日
;;本程序是在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>)
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
;;1 点列表排序
(defun sortpts (PTS FUN F FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (F a) (F b) fuzz))
(fun (F a) (F b))
)
)
)
)
;;2 选择集图元排序
(defun sortSS (PTS FUN F FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (F (car a)) (F (car b)) fuzz))
(fun (F (car a)) (F (car b)))
)
)
)
)
;;3 排序
(defun sortSS1 (myfun 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 (myfun Pts fun xyz fuzz))
)
)
;;4 本程序主程序
(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 (cons (cdr (assoc 10 en)) e) lst))
)
)
(mapcar 'cdr (sortSS1 sortSS lst KEY FUZZ))
)
(T
(cond
((= (type (caar ssPts)) 'LIST)
(mapcar 'cdr (sortSS1 sortSS ssPts KEY FUZZ))
)
(T (sortSS1 sortpts ssPts KEY FUZZ))
)
)
)
)
引用了，这个太强大了！ 本帖最后由 自贡黄明儒 于 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)))))
)
)
函数是以组码10为基准对图元进行排序，其实这里可以再增加一个取点函数，使程序的通用性更强。
这样就可以做到：以图元的中心点为基准排序、以图元包围框的左下角点为基准排序等效果。 看一下都要币呀，没币的人很悲催了！ 看看有没钱 本帖最后由 自贡黄明儒 于 2014-3-22 10:09 编辑
;;应用示例
;;自定义Max(可以是字母例表)
(defun MyMax (lst) (car (HH:ssPts:Sort lst "X" 1)))
老黄写的不错，大小写是个好想法 有更详细的介绍吗?感觉很好的样子。 yzxgwl 发表于 2013-9-6 15:09 static/image/common/back.gif
有更详细的介绍吗?感觉很好的样子。
;;本程序是在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>)
楼主最起码来个GIF格式的图片演示吧 老黄写的不错，大小写是个好想法 大儒的程序，一定要顶啊。