图元排序问题

xyp1964 · 发表于 2019-1-29 13:35

本帖最后由 xyp1964 于 2019-1-29 13:38 编辑

(defun c:tt (/ lst)
(setq ukw (Ukword 1 "1 2" "1-先上下后左右/2-先左右后上下" ukw)) (princ "\n请选择要排序的实体...")
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq i 0)
(repeat (sslength ss)
(setq pt (cdr (assoc 10 (entget (ssname ss i))))
lst (cons pt lst)
i (1+ i)
)
)
(setq lst (if (= ukw "1")
(vl-sort lst '(lambda (x y) (if (equal (cadr x) (cadr y) 1e-3) (< (car x) (car y))(> (cadr x) (cadr y)))))
(vl-sort lst '(lambda (x y)(if (equal (car x) (car y) 1e-3)(> (cadr x) (cadr y))(< (car x) (car y))))))
i 0
)
(mapcar '(lambda (x)
(setq i (1+ i) bh (itoa i))
(command "text" "j" "mc" "non" x 25 0 bh)
)
lst
)
)
)
(princ)
)

(defun c:tt (/ lst) 
  (setq ukw (Ukword 1 "1 2" "1-先上下后左右/2-先左右后上下" ukw))   (princ "\n请选择要排序的实体...") 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (setq i 0) 
      (repeat (sslength ss) 
        (setq pt  (cdr (assoc 10 (entget (ssname ss i)))) 
              lst (cons pt lst) 
              i          (1+ i) 
        ) 
      ) 
      (setq lst        (if (= ukw "1") 
                  (vl-sort lst '(lambda (x y) (if (equal (cadr x) (cadr y) 1e-3) (< (car x) (car y))(> (cadr x) (cadr y))))) 
                  (vl-sort lst '(lambda (x y)(if (equal (car x) (car y) 1e-3)(> (cadr x) (cadr y))(< (car x) (car y)))))) 
            i        0 
      ) 
      (mapcar '(lambda (x) 
                 (setq i  (1+ i)  bh (itoa i)) 
                 (command "text" "j" "mc" "non" x 25 0 bh) 
               ) 
              lst 
      ) 
    ) 
  ) 
  (princ) 
)

QQ873240166 · 发表于 2020-3-29 23:10

NNWS神速神速

Sonnenblumen · 发表于 2020-3-30 12:20

很好用，学习了

老张头头 · 发表于 2020-12-27 20:44

正要派用场，多谢多谢！

skg123 · 发表于 2021-5-21 15:08

6楼 zml84 大神代码强悍。，测试可行，还有有容差判断

修改 (if (equal (cadr e1) (cadr e2) 1e1) 中的 1e1 变量就实现容差

图片上白色上参考线，偏差参考线的圆照样编号，强大

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

图元排序问题

本帖子中包含更多资源