论坛 › A/VLISP › 点表排序、图元坐标点排序--------通吃------最终版2014.3.22

/db_自贡黄明儒_ 发表于 2013-9-9 08:34:33

点表排序、图元坐标点排序--------通吃------最终版2014.3.22

本帖最后由 /db_自贡黄明儒_ 于 2014-3-22 14:46 编辑

;;最终版
**** Hidden Message *****
;;*****************************************************************************通用点表排序
;;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))
               )
         )
      )
)
)
;;*****************************************************************************通用点表排序

zhangq_cai1 发表于 2013-9-9 08:49:17

看看，学习~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

ysq101 发表于 2013-9-9 10:15:07

明经里看到大神发的源码了

hao3ren 发表于 2013-9-9 10:31:09

万能点表排序

st788796 发表于 2013-9-9 12:54:41

看看长老有哪些改进

zytyd 发表于 2013-9-9 14:18:18

回复看看2

newer 发表于 2013-9-9 14:42:51

顶楼主，分享源代码。

liuyun242 发表于 2013-9-9 16:20:56

我记得以前看过类似的

dnbcgrass 发表于 2013-9-9 20:47:56

想看看到底如何进行排序的:)

zhong2013 发表于 2013-10-28 16:30:22

学习学习……下载备用。

cy956 发表于 2013-10-28 17:02:58

学习学习……下载备用。

海天风云 发表于 2013-10-29 14:24:57

有这么利害的东西，看看。

ynhh 发表于 2013-10-29 14:39:03

通吃的东东感觉很好
有点象自摸

ycllzhou 发表于 2013-11-1 08:36:30

学习学习，谢谢楼主

soly2006 发表于 2013-11-1 09:19:11

往上顶一下

查看完整版本: 点表排序、图元坐标点排序--------通吃------最终版2014.3.22