选择集排序(按坐标)

/db_自贡黄明儒_ · 发表于 2013-7-6 10:16:58

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

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

×

;;;******************************************************选择集SS排序
;;1 图元列表->选择集
;;2 选择集排序->图元列表
;;3 选择集排序->选择集
;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左
;;示例(setq ss (ssget)) (SS_Sort ss "D->U" "L->R")下到上,左到右
;;自贡黄明儒 2012.8.28
;;1 [功能] 图元列表->选择集 By caiqs
(defun lst->ss (lst / SS X)
(setq ss (ssadd))
(last (mapcar '(lambda (x) (ssadd x ss)) lst))
)
;;2 [功能] 选择集排序->图元列表
(defun SS_Sort_list (SS Sort1 Sort2 / E LST N PT10)
;;2.1 表排序
(defun Sort_pList (PLIST Sort1 Sort2 / SYMBOL1 SYMBOL2)
(cond
((member Sort1 (list "L->R" "R->L"))
(cond ((equal Sort1 "L->R") (setq Symbol1 '>))
(T (setq Symbol1 '<))
)
(cond ((equal Sort2 "D->U") (setq Symbol2 '>))
(T (setq Symbol2 '<))
)
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (car (car p1)) (car (car p2))) T)
((and (= (car (car p1)) (car (car p2)))
((eval Symbol2) (cadr (car p1)) (cadr (car p2)))
)
T
)
)
)
)
)
(T
(cond ((equal Sort1 "D->U") (setq Symbol1 '>))
(T (setq Symbol1 '<))
)
(cond ((equal Sort2 "L->R") (setq Symbol2 '>))
(T (setq Symbol2 '<))
)
(vl-sort
PLIST
'(lambda (p1 p2)
(cond (((eval Symbol1) (cadr (car p1)) (cadr (car p2))) T)
((and (= (cadr (car p1)) (cadr (car p2)))
((eval Symbol2) (car (car p1)) (car (car p2)))
)
T
)
)
)
)
)
)
)
;;2.2 选择集SS排序主程序
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq pt10 (cdr (assoc 10 (entget e))))
(setq lst (cons (cons pt10 e) lst))
)
(mapcar 'cdr (Sort_pList lst Sort1 Sort2))
)
;;3 [功能] 选择集排序->选择集
(defun SS_Sort (SS Sort1 Sort2)
(lst->ss (SS_Sort_list SS Sort1 Sort2))
)
;;;******************************************************选择集SS排序

;;;******************************************************选择集SS排序 
;;1 图元列表->选择集 
;;2 选择集排序->图元列表 
;;3 选择集排序->选择集 
;;"D->U"从下到上;"U->D"从上到下;"L->R"从左到右;"R->L"从右到左 
;;示例(setq ss (ssget)) (SS_Sort ss "D->U" "L->R")下到上,左到右 
;;自贡黄明儒 2012.8.28 
;;1 [功能] 图元列表->选择集 By caiqs 
(defun lst->ss (lst / SS X) 
  (setq ss (ssadd)) 
  (last (mapcar '(lambda (x) (ssadd x ss)) lst)) 
) 
;;2 [功能] 选择集排序->图元列表 
(defun SS_Sort_list (SS Sort1 Sort2 / E LST N PT10) 
  ;;2.1 表 排序 
  (defun Sort_pList (PLIST Sort1 Sort2 / SYMBOL1 SYMBOL2) 
    (cond 
      ((member Sort1 (list "L->R" "R->L")) 
       (cond ((equal Sort1 "L->R") (setq Symbol1 '>)) 
             (T (setq Symbol1 '<)) 
       ) 
       (cond ((equal Sort2 "D->U") (setq Symbol2 '>)) 
             (T (setq Symbol2 '<)) 
       ) 
       (vl-sort 
         PLIST 
         '(lambda (p1 p2) 
            (cond (((eval Symbol1) (car (car p1)) (car (car p2))) T) 
                  ((and        (= (car (car p1)) (car (car p2))) 
                        ((eval Symbol2) (cadr (car p1)) (cadr (car p2))) 
                   ) 
                   T 
                  ) 
            ) 
          ) 
       ) 
      ) 
      (T 
       (cond ((equal Sort1 "D->U") (setq Symbol1 '>)) 
             (T (setq Symbol1 '<)) 
       ) 
       (cond ((equal Sort2 "L->R") (setq Symbol2 '>)) 
             (T (setq Symbol2 '<)) 
       ) 
       (vl-sort 
         PLIST 
         '(lambda (p1 p2) 
            (cond (((eval Symbol1) (cadr (car p1)) (cadr (car p2))) T) 
                  ((and        (= (cadr (car p1)) (cadr (car p2))) 
                        ((eval Symbol2) (car (car p1)) (car (car p2))) 
                   ) 
                   T 
                  ) 
            ) 
          ) 
       ) 
      ) 
    ) 
  ) 
  ;;2.2 选择集SS排序 主程序 
  (repeat (setq n (sslength ss)) 
    (setq e (ssname ss (setq n (1- n)))) 
    (setq pt10 (cdr (assoc 10 (entget e)))) 
    (setq lst (cons (cons pt10 e) lst)) 
  ) 
  (mapcar 'cdr (Sort_pList lst Sort1 Sort2)) 
) 
;;3 [功能] 选择集排序->选择集 
(defun SS_Sort (SS Sort1 Sort2) 
  (lst->ss (SS_Sort_list SS Sort1 Sort2)) 
) 
;;;******************************************************选择集SS排序

Free-Lancer · 发表于 2013-7-6 10:33:27

支持一个，排序很难用通用，大多数根据需要自己改造来自: Android客户端

炫翔 · 发表于 2013-7-6 17:23:32

根据组码来排序的大多可以通用

w379106181 · 发表于 2018-1-27 17:31:07

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享

opqtanxun · 发表于 2020-5-31 13:32:21

感谢楼主，学习学习。

啊龍 · 发表于 2020-9-3 01:14:21

感谢楼主，学习学习。

大队长 · 发表于 2020-9-3 14:32:50

不错不错，正是我需要的

杨89 · 发表于 2020-9-3 15:46:43

谢谢分享谢谢分享

jiang__jin · 发表于 2020-11-26 09:50:24

谢谢分享,正在学习!

olenewman · 发表于 2020-11-26 15:34:47

好程序，学习了。

15989144277 · 发表于 2023-4-18 15:20:22

很好用，谢谢

杨89 · 发表于 2023-5-6 09:50:13

感谢楼主，学习学习。

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

[每日一码] 选择集排序(按坐标)

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

评分