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

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

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

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

×

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

;;最终版

游客，如果您要查看本帖隐藏内容请回复

;;*****************************************************************************通用点表排序
;;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))
)
)
)
)
)
;;*****************************************************************************通用点表排序

;;*****************************************************************************通用点表排序 
;;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

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

评分