【e派】工具箱函数再揭秘及应用实例

品茗新秀 · 发表于 2013-3-15 03:07:31

很想看看院长的 xyp-SsgetWithLine这个函数,可惜没找到.

1993063 · 发表于 2013-3-15 19:09:19

继续支持，顶出更多通用函数

lisp爱好者 · 发表于 2013-3-18 14:02:13

求院长的2个排序函数源码，先谢过院长

xyp-Sort-Plist
xyp-Sort

xyp1964 · 发表于 2013-3-18 20:07:50

本帖最后由 xyp1964 于 2017-11-20 21:52 编辑

(defun xyp-Sort-PList (lst mode / x y)
(defun aaa (lst fun1 fun2 / x y x1 x2 y1 y2)
(vl-sort lst
'(lambda (x y)
(setq x1 (caar x)
x2 (caar y)
y1 (cadar x)
y2 (cadar y)
)
(cond ((and (= x1 x2) (= y1 y2) (> (caddar x) (caddar y))) T)
((and (= y1 y2) (fun1 x1 x2)) T)
((fun2 y1 y2) T)
(T nil)
)
)
)
)
(defun bbb (lst fun1 fun2 / x y x1 x2 y1 y2 z1 z2)
(vl-sort lst
'(lambda (x y)
(setq x1 (caar x)
x2 (caar y)
y1 (cadar x)
y2 (cadar y)
)
(cond ((and (= x1 x2) (= y1 y2) (> (caddar x) (caddar y))) T)
((and (= x1 x2) (fun1 y1 y2)) T)
((fun2 x1 x2) T)
(T nil)
)
)
)
)
(cond ((= mode 1) (aaa lst < >)) ; 上→下，左→右
((= mode 2) (aaa lst > >)) ; 上→下，右→左
((= mode 3) (aaa lst < <)) ; 下→上，左→右
((= mode 4) (aaa lst > <)) ; 下→上，右→左
((= mode 5) (bbb lst < <)) ; 左→右，上→下
((= mode 6) (bbb lst > <)) ; 左→右，下→上
((= mode 7) (bbb lst > >)) ; 右→左，上→下
((= mode 8) (bbb lst < >)) ; 右→左，下→上
((= mode 9) ; 单一数值从小到大
(vl-sort lst '(lambda (x y) (< (car x) (car y))))
)
((= mode 10) ; 单一数值从大到小
(vl-sort lst '(lambda (x y) (> (car x) (car y))))
)
)
)

(defun xyp-Sort-PList (lst mode / x y) 
  (defun aaa (lst fun1 fun2 / x y x1 x2 y1 y2) 
    (vl-sort lst 
             '(lambda (x y) 
                (setq x1 (caar x) 
                      x2 (caar y) 
                      y1 (cadar x) 
                      y2 (cadar y) 
                ) 
                (cond ((and (= x1 x2) (= y1 y2) (> (caddar x) (caddar y))) T) 
                      ((and (= y1 y2) (fun1 x1 x2)) T) 
                      ((fun2 y1 y2) T) 
                      (T nil) 
                ) 
              ) 
    ) 
  ) 
  (defun bbb (lst fun1 fun2 / x y x1 x2 y1 y2 z1 z2) 
    (vl-sort lst 
             '(lambda (x y) 
                (setq x1 (caar x) 
                      x2 (caar y) 
                      y1 (cadar x) 
                      y2 (cadar y) 
                ) 
                (cond ((and (= x1 x2) (= y1 y2) (> (caddar x) (caddar y))) T) 
                      ((and (= x1 x2) (fun1 y1 y2)) T) 
                      ((fun2 x1 x2) T) 
                      (T nil) 
                ) 
              ) 
    ) 
  ) 
  (cond        ((= mode 1) (aaa lst < >))        ; 上→下，左→右 
        ((= mode 2) (aaa lst > >))        ; 上→下，右→左 
        ((= mode 3) (aaa lst < <))        ; 下→上，左→右 
        ((= mode 4) (aaa lst > <))        ; 下→上，右→左 
        ((= mode 5) (bbb lst < <))        ; 左→右，上→下 
        ((= mode 6) (bbb lst > <))        ; 左→右，下→上 
        ((= mode 7) (bbb lst > >))        ; 右→左，上→下 
        ((= mode 8) (bbb lst < >))        ; 右→左，下→上 
        ((= mode 9)                        ; 单一数值从小到大 
         (vl-sort lst '(lambda (x y) (< (car x) (car y)))) 
        ) 
        ((= mode 10)                        ; 单一数值从大到小 
         (vl-sort lst '(lambda (x y) (> (car x) (car y)))) 
        ) 
  ) 
)

xyp1964 · 发表于 2013-3-18 20:10:32

本帖最后由 xyp1964 于 2017-11-20 21:52 编辑

【函　　数】: XYP-SORT-PLIST
【功　　能】: 实体点集表排序
【语　　法】: (XYP-SORT-PLIST PLIST MODE)
【参数或返回】: MODE:1上下左右；2上下右左；3下上左右；4下上右左；5左右上下；6左右下上；7右左上下；8右左下上；9递增；10递减

;; 排序问题
(defun c:test1238 (/ i ss s1 pt)
(CMDLA0)
(setq mode (Uint 1 "" "方式码(1～8)" mode))
(xyp-MkLaCo (strcat "TEST" (itoa mode)) mode)
(setq ss (ssget '((0 . "*LINE")))
lst (xyp-Sort-Plist (xyp-Sort ss 10 "Y-max") mode)
ptn (mapcar '(lambda (x) (xyp-9pt x 5)) (mapcar 'cdr lst))
)
(xyp-Entmake-LwPolyline ptn nil)
(setq i 1)
(foreach pt ptn
(xyp-Text 5 pt (itoa i))
(setq i (1+ i))
)
(CMDLA1)
)

仲文玉 · 发表于 2013-3-18 22:07:05

院长的代码经典

再往上就可看见 · 发表于 2013-3-20 19:13:37

厉害，支持一个

xyp1964 · 发表于 2013-3-20 21:40:06

为支持新规则的顺利执行，本贴不再更新！

机械工程师 · 发表于 2013-3-21 09:05:51

可惜了。希望院长后续继续放源码。
支持院长。

cable2004 · 发表于 2013-3-21 12:19:14

可惜了。源码可以有！

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

[讨论] 【e派】工具箱函数再揭秘及应用实例

本帖子中包含更多资源