[求助]：请问选择一组文字，怎样按Y坐标排序？

yinzhenyu

如题

zhynt

按坐标排序本版已经讨论很多，你可以搜索一下。

whscom

用文字大师试试，这个程序论坛上有。

zhang8755

下面是我以前写的一个程序，功能是将”DATA“层的文字取出，并按照先X轴坐标，后Y轴坐标的顺序排序，再写入文件中。你可以看看我的程序，应该会有所帮助。

2. 
   
3.   [FONT=courier new]
   
4. (defun c:getdata ()
   
5.   (command "ucs" "w")
   
6.   (setq ss (ssget "x" '((8 . "data"))))
   
7.   (setq l (sslength ss))
   
8.   (setq datalist nil)
   
9.   (setq i 0)
   
10.   (while (< i l)
    
11.     (setq entdata (entget (ssname ss i)))
    
12.     (setq entlist (append (cdr (assoc '10 entdata))
    
13.                           (list (cdr (assoc '1 entdata)))
    
14.                   )
    
15.     )
    
16.     (setq datalist (append datalist (list entlist)))
    
17.     (setq i (1+ i))
    
18.   )
    
19.   (setq l (length datalist))
    
20.   (setq i 1)
    
21.   (while (< i l)
    
22.     (setq j i)
    
23.     (while (< j l)
    
24.       (setq y1 (cadr (nth (1- i) datalist)))
    
25.       (setq y2 (cadr (nth j datalist)))
    
26.       (if (and (< y1 y2) (> (abs (- y2 y1)) 1))
    
27.         (progn
    
28.           (setq m 0)
    
29.           (setq datalist2 nil)
    
30.           (while (< m l)
    
31.             (if        (= m (1- i))
    
32.               (setq
    
33.                 datalist2 (append datalist2 (list (nth j datalist)))
    
34.               )
    
35.               (progn
    
36.                 (if (= m j)
    
37.                   (setq        datalist2 (append datalist2
    
38.                                           (list (nth (1- i) datalist))
    
39.                                   )
    
40.                   )
    
41.                   (setq        datalist2
    
42.                          (append datalist2 (list (nth m datalist)))
    
43.                   )
    
44.                 )
    
45.               )
    
46.             )
    
47.             (setq m (1+ m))
    
48.           )
    
49.           (setq datalist datalist2)
    
50.         )
    
51.         (progn
    
52.           (setq x1 (car (nth (1- i) datalist)))
    
53.           (setq x2 (car (nth j datalist)))
    
54.           (if
    
55.             (and (< x2 x1) (> (abs (- x1 x2)) 2) (< (abs (- y2 y1)) 1))
    
56.              (progn
    
57.                (setq m 0)
    
58.                (setq datalist2 nil)
    
59.                (while (< m l)
    
60.                  (if (= m (1- i))
    
61.                    (setq datalist2
    
62.                           (append datalist2 (list (nth j datalist)))
    
63.                    )
    
64.                    (progn
    
65.                      (if (= m j)
    
66.                        (setq
    
67.                          datalist2 (append datalist2
    
68.                                            (list (nth (1- i) datalist))
    
69.                                    )
    
70.                        )
    
71.                        (setq datalist2 (append datalist2
    
72.                                                (list (nth m datalist))
    
73.                                        )
    
74.                        )
    
75.                      )
    
76.                    )
    
77.                  )
    
78.                  (setq m (1+ m))
    
79.                )
    
80.                (setq datalist datalist2)
    
81.              )
    
82.           )
    
83.         )
    
84.       )
    
85.       (setq j (1+ j))
    
86.     )
    
87.     (setq i (1+ i))
    
88.   )
    
89.   (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "r"))
    
90.   (if fn
    
91.     (progn
    
92.       (close fn)
    
93.       (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "a"))
    
94.     )
    
95.     (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "w"))
    
96.   )
    
97.   (setq i 0)
    
98.   (while (< i l)
    
99.     (setq one "")
    
100.     (setq str (cadddr (nth i datalist)))
     
101.     (if        (= i 0)
     
102.       (progn
     
103.         (setq strl (strlen str))
     
104.         (setq j 1)
     
105.         (while (<= j strl)
     
106.           (if (or (= ":" (substr str j 1)) (= "-" (substr str j 1)))
     
107.             (setq one (strcat one "",""))
     
108.             (setq one (strcat one (substr str j 1)))
     
109.           )
     
110.           (setq j (1+ j))
     
111.         )
     
112.         (setq str one)
     
113.       )
     
114.       (progn
     
115.         (setq strl (strlen str))
     
116.         (setq j 1)
     
117.         (while (<= j strl)
     
118.           (if (= "%%D" (substr str j 3))
     
119.             (progn
     
120.               (setq one (strcat one "°"))
     
121.               (setq j (1+ strl))
     
122.             )
     
123.             (setq one (strcat one (substr str j 1)))
     
124.           )
     
125.           (setq j (1+ j))
     
126.         )
     
127.         (setq str one)
     
128.       )
     
129.     )
     
130.     (princ (strcat """ str """) fn)
     
131.     (if (< i (1- l)) (princ "," fn))
     
132.     (setq i (1+ i))
     
133.   )
     
134.   (princ "\n" fn)
     
135.   (close fn)
     
136.   (prompt "\n该图中的高低腿配置数据已写入文件gtdata.txt中!")
     
137.   (princ)
     
138. )
     
139.   [/FONT]
     

<br />   [FONT=courier new]<br /> (defun c:getdata ()<br />   (command "ucs" "w")<br />   (setq ss (ssget "x" '((8 . "data"))))<br />   (setq l (sslength ss))<br />   (setq datalist nil)<br />   (setq i 0)<br />   (while (< i l)<br />     (setq entdata (entget (ssname ss i)))<br />     (setq entlist (append (cdr (assoc '10 entdata))<br />                           (list (cdr (assoc '1 entdata)))<br />                   )<br />     )<br />     (setq datalist (append datalist (list entlist)))<br />     (setq i (1+ i))<br />   )<br />   (setq l (length datalist))<br />   (setq i 1)<br />   (while (< i l)<br />     (setq j i)<br />     (while (< j l)<br />       (setq y1 (cadr (nth (1- i) datalist)))<br />       (setq y2 (cadr (nth j datalist)))<br />       (if (and (< y1 y2) (> (abs (- y2 y1)) 1))<br />         (progn<br />           (setq m 0)<br />           (setq datalist2 nil)<br />           (while (< m l)<br />             (if        (= m (1- i))<br />               (setq<br />                 datalist2 (append datalist2 (list (nth j datalist)))<br />               )<br />               (progn<br />                 (if (= m j)<br />                   (setq        datalist2 (append datalist2<br />                                           (list (nth (1- i) datalist))<br />                                   )<br />                   )<br />                   (setq        datalist2<br />                          (append datalist2 (list (nth m datalist)))<br />                   )<br />                 )<br />               )<br />             )<br />             (setq m (1+ m))<br />           )<br />           (setq datalist datalist2)<br />         )<br />         (progn<br />           (setq x1 (car (nth (1- i) datalist)))<br />           (setq x2 (car (nth j datalist)))<br />           (if<br />             (and (< x2 x1) (> (abs (- x1 x2)) 2) (< (abs (- y2 y1)) 1))<br />              (progn<br />                (setq m 0)<br />                (setq datalist2 nil)<br />                (while (< m l)<br />                  (if (= m (1- i))<br />                    (setq datalist2<br />                           (append datalist2 (list (nth j datalist)))<br />                    )<br />                    (progn<br />                      (if (= m j)<br />                        (setq<br />                          datalist2 (append datalist2<br />                                            (list (nth (1- i) datalist))<br />                                    )<br />                        )<br />                        (setq datalist2 (append datalist2<br />                                                (list (nth m datalist))<br />                                        )<br />                        )<br />                      )<br />                    )<br />                  )<br />                  (setq m (1+ m))<br />                )<br />                (setq datalist datalist2)<br />              )<br />           )<br />         )<br />       )<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "r"))<br />   (if fn<br />     (progn<br />       (close fn)<br />       (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "a"))<br />     )<br />     (setq fn (open (strcat (getvar "dwgprefix") "gtdata.txt") "w"))<br />   )<br />   (setq i 0)<br />   (while (< i l)<br />     (setq one "")<br />     (setq str (cadddr (nth i datalist)))<br />     (if        (= i 0)<br />       (progn<br />         (setq strl (strlen str))<br />         (setq j 1)<br />         (while (<= j strl)<br />           (if (or (= ":" (substr str j 1)) (= "-" (substr str j 1)))<br />             (setq one (strcat one "",""))<br />             (setq one (strcat one (substr str j 1)))<br />           )<br />           (setq j (1+ j))<br />         )<br />         (setq str one)<br />       )<br />       (progn<br />         (setq strl (strlen str))<br />         (setq j 1)<br />         (while (<= j strl)<br />           (if (= "%%D" (substr str j 3))<br />             (progn<br />               (setq one (strcat one "°"))<br />               (setq j (1+ strl))<br />             )<br />             (setq one (strcat one (substr str j 1)))<br />           )<br />           (setq j (1+ j))<br />         )<br />         (setq str one)<br />       )<br />     )<br />     (princ (strcat """ str """) fn)<br />     (if (< i (1- l)) (princ "," fn))<br />     (setq i (1+ i))<br />   )<br />   (princ "\n" fn)<br />   (close fn)<br />   (prompt "\n该图中的高低腿配置数据已写入文件gtdata.txt中!")<br />   (princ)<br /> )<br />   [/FONT]<br />

陌生人

取出程序要求的点（dxf或包围盒的特征点）
然后用 (vl-sort ptlst '(lambda (x y) (<(cadr x)(cadr y))))

lsjjm

最初由 yinzhenyu 发布
[B]如题 [/B]

请参考: for X坐标的.
(defun c:test ()
  (vl-load-com)
  (initget "Left Middle Right")
  (setq kw (getkword "\nAlgnment Style[Left/Middle/Right]:"))
  (setq ent0 (car (entsel "\nSelect Source Text:")))
  (pttext ent0)
  (setq pl pt1 pr pt2)
  (prompt "\Select Alignment Text:")
  (setq ss (ssget) n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (pttext (ssname ss n))
    (cond
      ((= kw "Left")
        (vla-put-alignment obj 6)
        (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pl)(cadr pt2)))))
      ((= kw "Middle")
        (vla-put-alignment obj 10)
        (setq dx (/ (- (car pr)(car pl)) 2))
        (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (+ (car pl) dx)(cadr pt2)))))
      ((= kw "Right")
        (vla-put-alignment obj 8)
        (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr pt2)))))
    );c
    (setq n (1+ n))
  )
)
;
(defun pttext (ent)
  (setq obj (vlax-ename->vla-object ent))
  (vla-getboundingbox obj 'pt1 'pt2)
  (setq pt1 (vlax-safearray->list pt1)
        pt2 (vlax-safearray->list pt2))
)