lty 发表于 2020-3-25 15:43:41

lisp实现排序

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

evayleung 发表于 2020-3-25 18:11:40

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

x_s_s_1 发表于 2020-3-25 18:17:13

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

lty 发表于 2020-3-26 08:42:36

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 发表于 2020-3-26 09:58:25

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

      )
    )
(setq i (+ 1 i))
)
)
试一哈哇

x_s_s_1 发表于 2020-3-26 11:10:52

本帖最后由 x_s_s_1 于 2020-3-26 11:14 编辑

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


lty 发表于 2020-3-26 15:10:51

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

非常感谢,你的程序非常完美!

lty 发表于 2020-3-26 15:12:28

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

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

jun353835273 发表于 2020-3-26 15:16:13

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

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

852456 发表于 2020-3-27 21:28:53

打开你的图是空白的
(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))
页: [1] 2
查看完整版本: lisp实现排序