lisp实现排序

lty

本人不会用lisp程序排序，排序后最终效果如图纸中右侧所示，望各路高手赐教！

evayleung

支持一下，以前好像有人发过出来的，你在论坛上找找。

x_s_s_1

vl-sort 先<y后<x，排序后表配合vl-remove-if和vl-remove-ifnot即可

lty

x_s_s_1 发表于 2020-3-25 18:17
vl-sort 先

对这几个函数我还不是很清楚，这是我写的排序程序，但是实现不了我所想要的功能，麻烦您给看看
(defun c:zdx2()
  (setvar "cmdecho" 0)
  (setq osm(getvar "osmode"))
  (setvar "osmode" 0)
  (if (tblsearch "layer" "bhc")
             (command "layer" "s" "bhc" "")
             (command "layer" "n" "bhc" "c" "4" "bhc" "s" "bhc" "")
    )      
  (princ "\n 请选择需要编号的圆:")
  (setq ss (ssget '((0 . "circle"))));过滤选择圆zdx
  (setq sn (if ss (sslength ss) 0));设sn为选择集的个数
  (princ)
  (setq ns 0 )
  (setq a1(getstring "\n加前缀<P>:"))
  (if (= a1 "")(setq a1 "P"))          ;假若参数是字符，回车空格键都是空值，不是nil
  (setq a2(getint"\n请输入起始数值<1>:"))
  (if (= a2 nil)(setq a2 1))     ;假若参数为数值，回车等于nil
  (setq ss2 '())
   (while (and (< ns sn) ss)   ;and表示后面两个参数都有值，否则输出nil  
          (setq a(rtos a2 2 0))
          (setq aa(strcat a1 a))
          (setq ssg (entget (ssname ss ns))  ;逐一获取选择集中的图元信息
                  yx(assoc 10 ssg)        ;求出圆心
                 ss2(cons (cdr yx) ss2)
                  r (cdr (assoc 40 ssg))  ;返回半径
                  y(cadr yx)              ;求出文字Y坐标
                  x(-(caddr yx)(* 1.8 r)) ;求出文字x坐标
                     ns (1+ ns)
                     )
     ;;以下排序输出,还需改进，不能按y值排列
                     (setq ss3(vl-sort ss2
                                  (function
                                    (lambda (x y)
;;;                                            (< (car x) (car y))
                                              (< (cadr x) (cadr y))
                                              )
                                    )
                                  )
                      )
;;;                      )
                     (setq ss2-yx(car ss3))
                 (command "text" "j" "Mc"  ss2-yx (* 1.4 r) "0" aa);标注文字
                 (setq a2 (1+ a2))    ;数值累加
     )
  (command "undo" "e")
  (setvar "osmode" osm)
(princ)
  )
(prompt "****【c:zdx2】****")
(princ)

jun353835273

1. (defun c:tt(  / ss lst ent ls out i )
   
2. (setq ss (ssget (list '(0 . "Circle"))))
   
3. (setq ls nil)
   
4. (while (> (sslength ss) 0)
   
5. (setq ent (ssname ss 0))
   
6. (setq ss (ssdel ent ss))
   
7. (setq ls (cons (cdr (assoc 10 (entget ent))) ls))
   
8.   )
   
9. (setq out
   
10. (vl-sort ls '(lambda (a b)
    
11.                             (if
    
12.                              (equal (cadr a) (cadr b) 0.1 )
    
13.                              (< (car a) (car b))
    
14.                              (< (cadr a) (cadr b))
    
15.                              )
    
16.                             )
    
17.                          )
    
18.       )
    
19. (setq i 0)
    
20. (foreach e out
    
21. (entmake
    
22.       (list '(0 . "TEXT")
    
23.       (cons 10 e)
    
24.       (cons 40  450)
    
25.       (cons 1 (itoa i))
    
26. 
    
27.       )
    
28.     )
    
29.   (setq i (+ 1 i))
    
30. )
    
31. )

(defun c:tt(  / ss lst ent ls out i )<br /> (setq ss (ssget (list '(0 . "Circle"))))<br /> (setq ls nil)<br /> (while (> (sslength ss) 0)<br /> (setq ent (ssname ss 0))<br /> (setq ss (ssdel ent ss))<br /> (setq ls (cons (cdr (assoc 10 (entget ent))) ls))<br />   )<br /> (setq out <br /> (vl-sort ls '(lambda (a b)<br />                             (if<br />                              (equal (cadr a) (cadr b) 0.1 )<br />                              (< (car a) (car b))<br />                              (< (cadr a) (cadr b))<br />                              )<br />                             )<br />                          )<br />       )<br /> (setq i 0)<br /> (foreach e out<br /> (entmake<br />       (list '(0 . "TEXT")<br />       (cons 10 e)<br />       (cons 40  450)<br />       (cons 1 (itoa i))<br /> <br />       )<br />     )<br />   (setq i (+ 1 i))<br /> )<br /> )

试一哈哇

x_s_s_1

lty 发表于 2020-3-26 08:42
对这几个函数我还不是很清楚，这是我写的排序程序，但是实现不了我所想要的功能，麻烦您给看看
(defun c ...

根据您的稍微改了一下

lty

x_s_s_1 发表于 2020-3-26 11:10
根据您的稍微改了一下

非常感谢，你的程序非常完美！

lty

jun353835273 发表于 2020-3-26 09:58
试一哈哇

谢谢了，但是您的这个程序只实现了数字编号，没有排号

jun353835273

lty 发表于 2020-3-26 15:12
谢谢了，但是您的这个程序只实现了数字编号，没有排号

改下就可以，思路是那样的

852456

打开你的图是空白的  
(setq lst '((1 1) (1 2) (1 3) (2 1) (2 2) (2 3)))
(vl-sort lst '(lambda (e1 e2)(if (equal (cadr e1) (cadr e2) 1)(< (car e1) (car e2))
(< (cadr e2) (cadr e1)))))
返回结果：((1 3) (2 3) (1 2) (2 2) (1 1) (2 1))