lisp实现排序

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

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

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

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

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

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

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

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

(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 40 450)
(cons 1 (itoa i))
)
)
(setq i (+ 1 i))
)
)

试一哈哇

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

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

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

根据您的稍微改了一下

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

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

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

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

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

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

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

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

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

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

打开你的图是空白的
(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))

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

[提问] lisp实现排序

本帖子中包含更多资源

点评

本帖子中包含更多资源