lisp实现排序
本人不会用lisp程序排序,排序后最终效果如图纸中右侧所示,望各路高手赐教!支持一下,以前好像有人发过出来的,你在论坛上找找。 vl-sort 先<y后<x,排序后表配合vl-remove-if和vl-remove-ifnot即可 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)
(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:14 编辑
lty 发表于 2020-3-26 08:42
对这几个函数我还不是很清楚,这是我写的排序程序,但是实现不了我所想要的功能,麻烦您给看看
(defun c ...
根据您的稍微改了一下
x_s_s_1 发表于 2020-3-26 11:10
根据您的稍微改了一下
非常感谢,你的程序非常完美! jun353835273 发表于 2020-3-26 09:58
试一哈哇
谢谢了,但是您的这个程序只实现了数字编号,没有排号 lty 发表于 2020-3-26 15:12
谢谢了,但是您的这个程序只实现了数字编号,没有排号
改下就可以,思路是那样的 打开你的图是空白的
(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