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

yoyoho · 发表于 2018-1-1 09:59:52

感谢 xyp1964 分享学习!!!!

xyp1964 · 发表于 2018-1-12 23:45:42

SYTDD · 发表于 2018-2-13 10:35:59

感谢分享，高手就是强！

SYTDD · 发表于 2018-2-24 16:21:20

谢谢分享，院长太

半夜星星 · 发表于 2018-3-24 22:28:20

这么好的工具箱，需望可以用到啊

不想多说 · 发表于 2018-5-15 00:23:16

可惜学得太迟，院长出手果然不同凡响

xyp1964 · 发表于 2018-11-16 20:59:14

;; xyp-Sort-PList 点集实体排序 (xyp-Sort-Plist lst mode) mode 1~10
(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 x (trans (car x) 0 1)
y (trans (car y) 0 1)
x1 (car x)
x2 (car y)
y1 (cadr x)
y2 (cadr y)
)
(cond ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr 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)
(vl-sort lst
'(lambda (x y)
(setq x (trans (car x) 0 1)
y (trans (car y) 0 1)
x1 (car x)
x2 (car y)
y1 (cadr x)
y2 (cadr y)
)
(cond ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr 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 '<)) ; 单一数值从小到大
((= mode 10) (vl-sort lst '>)) ; 单一数值从大到小
)
)

;; xyp-Sort-PList 点集实体排序 (xyp-Sort-Plist lst mode) mode 1~10 
(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 x (trans (car x) 0 1) 
                      y         (trans (car y) 0 1) 
                      x1 (car x) 
                      x2 (car y) 
                      y1 (cadr x) 
                      y2 (cadr y) 
                ) 
                (cond ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr 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) 
    (vl-sort lst 
             '(lambda (x y) 
                (setq x (trans (car x) 0 1) 
                      y         (trans (car y) 0 1) 
                      x1 (car x) 
                      x2 (car y) 
                      y1 (cadr x) 
                      y2 (cadr y) 
                ) 
                (cond ((and (= x1 x2) (= y1 y2) (> (caddr x) (caddr 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 '<))                  ; 单一数值从小到大 
        ((= mode 10) (vl-sort lst '>))                  ; 单一数值从大到小 
  ) 
)

xyp1964 · 发表于 2018-11-16 21:03:19

;; tt(圆孔排序8式)
(defun c:tt ()
(xyp-StartSc)
(setq ukw (Ukword 1
"1 2 3 4 5 6 7 8"
"1上下左右;2上下右左;3下上左右;4下上右左;5左右上下;6左右下上;7右左上下;8右左下上;"
ukw
)
)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq lst (xyp-Ss2List ss)
ptn (mapcar '(lambda (x) (list (xyp-DXF 10 x) x)) lst)
)
(setq ptn (xyp-Sort-PList ptn (atoi ukw))
ptn (mapcar 'car ptn)
i 0
aa (mapcar '(lambda (x) (setq i (1+ i)) (xyp-Text 5 x (itoa i))) ptn)
)
)
)
(xyp-End)
)

cadmap · 发表于 2018-11-17 10:21:55

从一楼一直走到底，院长辛苦了

yoyoho · 发表于 2018-11-17 11:10:00

感谢 xyp1964 分享学习!!!!

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

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

本帖子中包含更多资源

点评