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

adc

请教院长这个函数xyp-sc能公开吗？

726613

感谢楼主分享好东西

海盗曹

来支持院长~

成仔

很强大，占位学习

露水2

支持看门的

cheng5276

好东西啊，三角函数帮了我大忙，数学差啊，多谢院长

004

哈哈，终于见到了院长的真源码，太好了。感谢院长。

xyp1964

1. ;; 直线批量等分
   
2. (defun c:test1146 ()
   
3.   (CMDLA0)
   
4.   (setq int (Uint 7 "" "整数" int)
   
5. ss  (ssget '((0 . "line")))
   
6. lst (xyp-Sort-Plist (xyp-Sort ss 10 "x-min") 6)
   
7. lst (mapcar 'cdr lst)
   
8. i   0
   
9.   )
   
10.   (while (and (setq s1 (nth i lst))
    
11.        (setq s2 (nth (setq i (1+ i)) lst))
    
12.   )
    
13.     (setq s1   (xyp-Line-DtFormat s1)
    
14.    s2   (xyp-Line-DtFormat s2)
    
15.    ptn1 (xyp-get-CurveDivNumPtlst s1 int)
    
16.    ptn2 (xyp-get-CurveDivNumPtlst s2 int)
    
17.     )
    
18.     (mapcar '(lambda (x y) (xyp-line x y)) ptn1 ptn2)
    
19.   )
    
20.   (CMDLA1)
    
21. )
    

;; 直线批量等分<br /> (defun c:test1146 ()<br />   (CMDLA0)<br />   (setq int (Uint 7 "" "整数" int)<br /> ss  (ssget '((0 . "line")))<br /> lst (xyp-Sort-Plist (xyp-Sort ss 10 "x-min") 6)<br /> lst (mapcar 'cdr lst)<br /> i   0<br />   )<br />   (while (and (setq s1 (nth i lst))<br />        (setq s2 (nth (setq i (1+ i)) lst))<br />   )<br />     (setq s1   (xyp-Line-DtFormat s1)<br />    s2   (xyp-Line-DtFormat s2)<br />    ptn1 (xyp-get-CurveDivNumPtlst s1 int)<br />    ptn2 (xyp-get-CurveDivNumPtlst s2 int)<br />     )<br />     (mapcar '(lambda (x y) (xyp-line x y)) ptn1 ptn2)<br />   )<br />   (CMDLA1)<br /> )<br />

xyp1964

1. ;; xyp-SortListSub 以表内某子项为首重新排序 (xyp-SortListSub lst sub)
   
2. ;; (xyp-SortListSub '(1 2 3 4 5 6 7 8 9 10) 5)→(5 6 7 8 9 10 1 2 3 4)
   
3. (defun xyp-SortListSub (lst sub / a n i new)
   
4.   (if (setq a (member sub lst))
   
5.     (progn
   
6.       (setq n (- (length lst) (length a))
   
7.             i   0
   
8.             new  '()
   
9.       )
   
10.       (while (< i n)
    
11.         (setq new (cons (nth i lst) new)
    
12.               i  (1+ i)
    
13.         )
    
14.       )
    
15.       (append a (reverse new))
    
16.     )
    
17.   )
    
18. )
    

;; xyp-SortListSub 以表内某子项为首重新排序 (xyp-SortListSub lst sub)<br /> ;; (xyp-SortListSub '(1 2 3 4 5 6 7 8 9 10) 5)→(5 6 7 8 9 10 1 2 3 4)<br /> (defun xyp-SortListSub (lst sub / a n i new)<br />   (if (setq a (member sub lst))<br />     (progn<br />       (setq n (- (length lst) (length a))<br />             i   0<br />             new  '()<br />       )<br />       (while (< i n)<br />         (setq new (cons (nth i lst) new)<br />               i  (1+ i)<br />         )<br />       )<br />       (append a (reverse new))<br />     )<br />   )<br /> )<br />

crazylsp

这个排序很简洁。