如何获得排序后圆的图元表？

kanxiaokan

我需要得到如图所示的效果，如何修改下面的代码？

2. (defun c:tt ()
   
3.     (princ "\n请选择要排序的实体...")
   
4.     (if  (setq ss (ssget))
   
5.   (progn
   
6.       ;; 1、获取点位表
   
7.       (setq lst '()
   
8.       i   0
   
9.       )
   
10.       (repeat (sslength ss)
    
11.     (setq en  (ssname ss i)
    
12.           ent (entget en)
    
13.           pt  (cdr (assoc 10 ent))
    
14.           lst (cons pt lst)
    
15.           i    (1+ i)
    
16.     )
    
17.       )
    
18.       ;; 2、排序
    
19.       (setq
    
20.     lst (vl-sort lst '(lambda (e1 e2)
    
21.                   (if (equal (car e1) (car e2) 1e1)
    
22.                     (if (equal (cadr e1) (cadr e2) 1e1)
    
23.                       (< (car e1) (car e2))
    
24.                       (< (cadr e1) (cadr e2))
    
25.                     )
    
26.                     (< (car e1) (car e2))
    
27.                   )
    
28.                 )
    
29.   )
    
30.       )
    
31.       ;; 3、写序号文字
    
32.       (setq i 1)
    
33.       (foreach pt  lst
    
34.     (command "_.text" "j" "mc"  "non"pt (getvar "TEXTSIZE") 0 (itoa i))
    
35.     (setq i (1+ i))
    
36.       )
    
37.   )
    
38.     )
    
39.     (princ)
    
40. )

(defun c:tt ()<br />     (princ "\n请选择要排序的实体...")<br />     (if  (setq ss (ssget))<br />   (progn<br />       ;; 1、获取点位表<br />       (setq lst '()<br />       i   0<br />       )<br />       (repeat (sslength ss)<br />     (setq en  (ssname ss i)<br />           ent (entget en)<br />           pt  (cdr (assoc 10 ent))<br />           lst (cons pt lst)<br />           i    (1+ i)<br />     )<br />       )<br />       ;; 2、排序<br />       (setq<br />     lst (vl-sort lst '(lambda (e1 e2)<br />                   (if (equal (car e1) (car e2) 1e1)<br />                     (if (equal (cadr e1) (cadr e2) 1e1)<br />                       (< (car e1) (car e2))<br />                       (< (cadr e1) (cadr e2))<br />                     )<br />                     (< (car e1) (car e2))<br />                   )<br />                 )<br />   )<br />       )<br />       ;; 3、写序号文字<br />       (setq i 1)<br />       (foreach pt  lst<br />     (command "_.text" "j" "mc"  "non"pt (getvar "TEXTSIZE") 0 (itoa i))<br />     (setq i (1+ i))<br />       )<br />   )<br />     )<br />     (princ)<br /> )

satan421

;;   test

yshf

;程序修改为如下：
(defun c:tt ()
    (command "_.undo" "be")
    (if (= (setq YxWc (getreal "\nX坐标容许差<10>=")) nil)
        (setq YxWc 10.0)
    )
  
    (If (= (setq WzGd (getreal (strcat "\n编号文字高度<" (rtos (getvar "TEXTSIZE")) ">="))) nil)
        (setq WzGd (getvar "TEXTSIZE"))
        (setvar "TEXTSIZE" WzGd)
    )
  
    (princ "\n请选择要排序的实体...")
    (if (setq ss (ssget '((0 . "circle"))))
        (progn
             ;; 1、获取点位表
             (setq lst '()
                   i   0
             )
             (repeat (sslength ss)
                 (setq ent (ssname ss i)
                       dxf (entget ent)
                       pt  (cdr (assoc 10 dxf))
                       lst (cons pt lst)
                       i   (1+ i)
                  )
             )
             ;; 2、排序
             (setq lst (vl-sort lst '(lambda (e1 e2)
                                        (if (equal (car e1) (car e2) YxWc)
                                            (< (cadr e1) (cadr e2))
                                            (< (car  e1) (car  e2))
                                        )
                                    )
                       )
             )
             (setq pts nil)
             (setq i 1)
             (while lst
                 (setq pt (car lst))
                 (setq ptb (vl-remove-if '(lambda(ptt)(not (equal (car pt) (car ptt) YxWc))) lst))
                 (mapcar '(lambda(ptt)(setq lst (vl-remove ptt lst))) ptb)
                 (if (= i (* 2 (fix (* 0.5 i))))
                     (setq ptb (reverse ptb))
                 )
                 (setq pts (append (reverse ptb) pts))
                 (setq i (1+ i))
             )
             (setq pts (reverse pts))
             ;; 3、写序号文字
             (setq i 1)
             (foreach pt pts
                  (command "_.text" "j" "mc"  "non" pt WzGd 0 (itoa i))
                  (setq i (1+ i))
             )
        )
    )
    (command "_.undo" "e")
    (princ)
)

satan421

1、实际存在像图中这样的线连接所有圆，还是此线只是配合箭头示意？
2、图元表是什么，圆的图元资料吗？
3、你是只要这一种排序的情况，还是可能有很多种情况？

kanxiaokan

satan421 发表于 2019-7-24 13:44
1、实际存在像图中这样的线连接所有圆，还是此线只是配合箭头示意？
2、图元表是什么，圆的图元资料吗？
...

粉色的线是配合箭头的示意图。
按示意图排列后获得的圆的图元表

start4444

论坛搜一下很多排序代码，你这种规律的就按照xy值排列应该好搞的

kanxiaokan

start4444 发表于 2019-7-24 14:34
论坛搜一下很多排序代码，你这种规律的就按照xy值排列应该好搞的

找到类似的，改了一下，还是达不到我想要的。我更新帖子了。大佬您帮看一下，如何改？

satan421

1、先根据X坐标分组，需要考虑容差(这个容差不好确定，需要考虑不止一种因素)
2、得到分组后，每组内再根据Y坐标的大小排序
3、组内排序完成后，再根据每组的第一个元素的X坐标排序
4、根据排序的结果，偶数序号的组元素顺序反转
5、按顺序将各组元素合并为一组

kanxiaokan

satan421 发表于 2019-7-25 08:50
;;   test

大佬你这个，是类似7楼的方法吗？能否给代码研究一下。

satan421

是按我自己的思路写的。
再给你个子函数，你应该能写出来了。

1. ;;点表根据X坐标值分组(考虑容差)
   
2. ;;by satan421
   
3. (defun classify (lst fuzzy / alst tlst x)
   
4.   (setq alst '())
   
5.   (while lst
   
6.     (setq x (caar lst) tlst '())
   
7.     (mapcar (function(lambda (n) (if (equal (car n) x fuzzy) (setq tlst (cons n tlst))))) lst)
   
8.     (setq alst (cons (reverse tlst) alst))
   
9.     (mapcar (function(lambda(n)(if (member n lst) (setq lst (vl-remove n lst))))) tlst)
   
10.   )
    
11.   (reverse alst)
    
12. )

;;点表根据X坐标值分组(考虑容差)<br /> ;;by satan421<br /> (defun classify (lst fuzzy / alst tlst x)<br />   (setq alst '())<br />   (while lst<br />     (setq x (caar lst) tlst '())<br />     (mapcar (function(lambda (n) (if (equal (car n) x fuzzy) (setq tlst (cons n tlst))))) lst)<br />     (setq alst (cons (reverse tlst) alst))<br />     (mapcar (function(lambda(n)(if (member n lst) (setq lst (vl-remove n lst))))) tlst)<br />   )<br />   (reverse alst)<br /> )