将文字集合按对齐点坐标排序

lostbalance

这个是明经上递增刷的部分框选代码，作用是文字的选择集按y坐标排序，然后按x坐标排序。对于左对齐的同列文字，x值相同，排序是按y从下到上。
但位于其他对齐，比如中间对齐的同列文字，虽然对齐点的x相同，但由于文字长度不同，插入点的x不同，程序就认为是不同的列，导致会因为部分长度较长的文字排序较为靠前。
所以，想求教下如何修改，可以按照文字的对齐点来对文字集合排序。

1. (setq lst (vl-sort lst (function (lambda
   
2.     (e1 e2) ; 框选文本先由下到上排序(其它情况自己修改)
   
3.     (< (cadr (car e1)) (cadr (car e2)))
   
4. ))))
   
5. (setq lst (vl-sort lst (function (lambda
   
6.     (e1 e2) ; 框选文本后由左到右排序(其它情况自己修改)
   
7.     (< (car (car e1))
   
8.         (if (and
   
9.                 (>= (car (car e2)) (- (car (car e1)) txtlong))
   
10.                 (<= (car (car e2)) (+ (car (car e1)) txtlong))
    
11.             )
    
12.             (car (car e1))
    
13.             (car (car e2))
    
14. ))))))

(setq lst (vl-sort lst (function (lambda<br />     (e1 e2) ; 框选文本先由下到上排序(其它情况自己修改)<br />     (< (cadr (car e1)) (cadr (car e2)))<br /> ))))<br /> (setq lst (vl-sort lst (function (lambda<br />     (e1 e2) ; 框选文本后由左到右排序(其它情况自己修改)<br />     (< (car (car e1))<br />         (if (and<br />                 (>= (car (car e2)) (- (car (car e1)) txtlong))<br />                 (<= (car (car e2)) (+ (car (car e1)) txtlong))<br />             )<br />             (car (car e1))<br />             (car (car e2))<br /> ))))))

springwillow

2. 以前写的，看看吧！还有优化的空间。
   
3. (defun c:zjzs (/)
   
4.   (if (= str nil)
   
5.     (setq oldstr 1)
   
6.     (setq oldstr str)
   
7.   )
   
8.   (setq  str (getint (strcat "\n0=左对正；1=居中对正；2=右对正<"
   
9.           (rtos oldstr 2 0)
   
10.           ">:"
    
11.         )
    
12.       )
    
13.   )
    
14.   (if (= str nil)
    
15.     (setq str oldstr)
    
16.   )
    
17.   (if (= texthg nil)
    
18.     (setq oldtexthg 1.1)
    
19.     (setq oldtexthg texthg)
    
20.   )
    
21.   (setq
    
22.     texthg (getreal
    
23.        (strcat "\n行高与字高的比<" (rtos oldtexthg 2 1) ">:")
    
24.      )
    
25.   )
    
26.   (if (= texthg nil)
    
27.     (setq texthg oldtexthg)
    
28.   )
    
29.   (princ)
    
30. )
    
31. (DEFUN C:ZZ (/      ss    name  a     t1    t1ang t1h  ppp   i
    
32.         entlst    dis  e1    e2    sss    ent  pt1   pt1ang
    
33.         ah    k    pt2  nn    len   n    s  en1   oldp
    
34.         newp  ptdiv pt11
    
35.        )
    
36.   (princ "本工具由孤帆制作！")
    
37.   (defun textvlsort (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)
    
38.     (setq name (ssname ss 0))
    
39.     (setq a (entget name))
    
40.     (setq t1 (cdr (assoc 11 a)))
    
41.     (setq t1ang (cdr (assoc 50 a)))
    
42.     (setq t1h (cdr (assoc 40 a)))
    
43.     (setq ppp (polar t1
    
44.          (+ t1ang (* pi 0.5))
    
45.          (* t1h 100000)
    
46.         )
    
47.     )
    
48.     (setq i 0)
    
49.     (setq entlst '())
    
50.     (repeat (sslength ss)
    
51.       (setq name (ssname ss i))
    
52.       (setq a (entget name))
    
53.       (setq t1 (cdr (assoc 11 a)))
    
54.       (setq dis (distance t1 ppp))
    
55.       (setq entlst (append entlst (list (list dis name))))
    
56.       (setq i (1+ i))
    
57.     )
    
58.     (setq entlst (vl-sort
    
59.        entlst
    
60.        (function
    
61.          (lambda (e1 e2)
    
62.            (< (car e1) (car e2))
    
63.          )
    
64.        )
    
65.      )
    
66.     )
    
67. 
    
68.     (setq sss (ssadd))
    
69.     (setq i 0)
    
70.     (repeat (length entlst)
    
71.       (setq ent (nth i entlst))
    
72.       (setq sss (ssadd (cadr ent) sss))
    
73.       (setq i (1+ i))
    
74.     )
    
75.     sss
    
76.   )
    
77.   (defun textvlsort0 (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)
    
78.     (setq name (ssname ss 0))
    
79.     (setq a (entget name))
    
80.     (setq t1 (cdr (assoc 10 a)))
    
81.     (setq t1ang (cdr (assoc 50 a)))
    
82.     (setq t1h (cdr (assoc 40 a)))
    
83.     (setq ppp (polar t1
    
84.          (+ t1ang (* pi 0.5))
    
85.          (* t1h 100000)
    
86.         )
    
87.     )
    
88.     (setq i 0)
    
89.     (setq entlst '())
    
90.     (repeat (sslength ss)
    
91.       (setq name (ssname ss i))
    
92.       (setq a (entget name))
    
93.       (setq t1 (cdr (assoc 10 a)))
    
94.       (setq dis (distance t1 ppp))
    
95.       (setq entlst (append entlst (list (list dis name))))
    
96.       (setq i (1+ i))
    
97.     )
    
98.     (setq entlst (vl-sort
    
99.        entlst
    
100.        (function
     
101.          (lambda (e1 e2)
     
102.            (< (car e1) (car e2))
     
103.          )
     
104.        )
     
105.      )
     
106.     )
     
107. 
     
108.     (setq sss (ssadd))
     
109.     (setq i 0)
     
110.     (repeat (length entlst)
     
111.       (setq ent (nth i entlst))
     
112.       (setq sss (ssadd (cadr ent) sss))
     
113.       (setq i (1+ i))
     
114.     )
     
115.     sss
     
116.   )
     
117.   (defun textdalig (ss / a ah k name pt1 pt1ang pt2)
     
118.     (setq name (ssname ss 0))
     
119.     (setq a (entget name))
     
120.     (setq pt1 (cdr (assoc 11 a)))
     
121.     (setq pt1ang (cdr (assoc 50 a)))
     
122.     (setq ah (* (cdr (assoc 40 a)) texthg))
     
123.     (setq k 1)
     
124.     (repeat (1- (sslength ss))
     
125.       (setq name (ssname ss k))
     
126.       (setq a (entget name))
     
127.       (setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))
     
128.       (setq a (subst (cons 11 pt2) (assoc 11 a) a))
     
129.       (entmod a)
     
130.       (setq pt1 pt2)
     
131.       (setq k (1+ k))
     
132.     )
     
133.   )
     
134.   (defun textdalig0 (ss / a ah k name pt1 pt1ang pt2)
     
135.     (setq name (ssname ss 0))
     
136.     (setq a (entget name))
     
137.     (setq pt1 (cdr (assoc 10 a)))
     
138.     (setq pt1ang (cdr (assoc 50 a)))
     
139.     (setq ah (* (cdr (assoc 40 a)) texthg))
     
140.     (setq k 1)
     
141.     (repeat (1- (sslength ss))
     
142.       (setq name (ssname ss k))
     
143.       (setq a (entget name))
     
144.       (setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))
     
145.       (setq a (subst (cons 10 pt2) (assoc 10 a) a))
     
146.       (entmod a)
     
147.       (setq pt1 pt2)
     
148.       (setq k (1+ k))
     
149.     )
     
150.   )
     
151. 
     
152.   (if (= str nil)
     
153.     (setq str 1)
     
154.   )
     
155.   (if (= texthg nil)
     
156.     (setq texthg 1.1)
     
157.   )
     
158.   (setvar "CMDECHO" 0)
     
159.   (setq  test T
     
160.   nn 0
     
161.   )
     
162.   (while test
     
163.     (setq ss (ssadd))
     
164.     (princ "\n命令zjzs进行设置! \n选择文字:")
     
165.     (setq ss (ssget '((0 . "TEXT"))))
     
166.     (if  (= nil ss)
     
167.       (setq test nil)
     
168.       (progn
     
169.   (setq len (sslength ss))
     
170.   (setq n  1
     
171.         s  1
     
172.   )
     
173.   (cond
     
174.     ((= str 0)
     
175.      (while (<= n len)
     
176.        (setq en1 (ssname ss (1- n)))
     
177.        (setq a (entget en1))
     
178.        (if (= "TEXT" (cdr (assoc 0 a)))
     
179.          (progn
     
180.      (setq ent (subst (cons 72 str) (assoc 72 a) a))
     
181.      (setq ent (subst (cons 73 0) (assoc 73 ent) ent))
     
182.      (entmod ent)
     
183.          )
     
184.        )
     
185.        (setq n (1+ n))
     
186.      )
     
187. 
     
188. 
     
189. 
     
190.      (setq ss (textvlsort0 ss))
     
191.      (textdalig0 ss)
     
192.     )
     
193.     (t
     
194.      (while (<= n len)
     
195.        (setq en1 (ssname ss (1- n)))
     
196.        (setq a (entget en1))
     
197.        (if (= "TEXT" (cdr (assoc 0 a)))
     
198.          (progn
     
199.      (setq oldp (cdr (assoc 10 a)))
     
200.      (setq ent (subst (cons 72 str) (assoc 72 a) a))
     
201.      (setq ent (subst (cons 73 0) (assoc 73 ent) ent))
     
202.      (entmod ent)
     
203.      (setq ent (entget en1))
     
204.      (setq newp (cdr (assoc 10 ent)))
     
205.      (setq ptdiv (mapcar '- oldp newp))
     
206.      (setq pt11 (cdr (assoc 11 ent)))
     
207.      (setq pt11 (mapcar '+ ptdiv pt11))
     
208.      (setq ent (subst (cons 11 pt11) (assoc 11 ent) ent))
     
209.      (entmod ent)
     
210.          )
     
211.        )
     
212.        (setq n (1+ n))
     
213.      )
     
214. 
     
215. 
     
216. 
     
217.      (setq ss (textvlsort ss))
     
218.      (textdalig ss)
     
219.     )
     
220.   )
     
221.       )
     
222.     )
     
223.   )
     
224.   (princ)
     
225.   )
     

以前写的，看看吧！还有优化的空间。<br /> (defun c:zjzs (/)<br />   (if (= str nil)<br />     (setq oldstr 1)<br />     (setq oldstr str)<br />   )<br />   (setq  str (getint (strcat "\n0=左对正；1=居中对正；2=右对正<"<br />           (rtos oldstr 2 0)<br />           ">:"<br />         )<br />       )<br />   )<br />   (if (= str nil)<br />     (setq str oldstr)<br />   )<br />   (if (= texthg nil)<br />     (setq oldtexthg 1.1)<br />     (setq oldtexthg texthg)<br />   )<br />   (setq<br />     texthg (getreal<br />        (strcat "\n行高与字高的比<" (rtos oldtexthg 2 1) ">:")<br />      )<br />   )<br />   (if (= texthg nil)<br />     (setq texthg oldtexthg)<br />   )<br />   (princ)<br /> )<br /> (DEFUN C:ZZ (/      ss    name  a     t1    t1ang t1h  ppp   i<br />         entlst    dis  e1    e2    sss    ent  pt1   pt1ang<br />         ah    k    pt2  nn    len   n    s  en1   oldp<br />         newp  ptdiv pt11<br />        )<br />   (princ "本工具由孤帆制作！")<br />   (defun textvlsort (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)<br />     (setq name (ssname ss 0))<br />     (setq a (entget name))<br />     (setq t1 (cdr (assoc 11 a)))<br />     (setq t1ang (cdr (assoc 50 a)))<br />     (setq t1h (cdr (assoc 40 a)))<br />     (setq ppp (polar t1<br />          (+ t1ang (* pi 0.5))<br />          (* t1h 100000)<br />         )<br />     )<br />     (setq i 0)<br />     (setq entlst '())<br />     (repeat (sslength ss)<br />       (setq name (ssname ss i))<br />       (setq a (entget name))<br />       (setq t1 (cdr (assoc 11 a)))<br />       (setq dis (distance t1 ppp))<br />       (setq entlst (append entlst (list (list dis name))))<br />       (setq i (1+ i))<br />     )<br />     (setq entlst (vl-sort<br />        entlst<br />        (function<br />          (lambda (e1 e2)<br />            (< (car e1) (car e2))<br />          )<br />        )<br />      )<br />     )<br /> <br />     (setq sss (ssadd))<br />     (setq i 0)<br />     (repeat (length entlst)<br />       (setq ent (nth i entlst))<br />       (setq sss (ssadd (cadr ent) sss))<br />       (setq i (1+ i))<br />     )<br />     sss<br />   )<br />   (defun textvlsort0 (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)<br />     (setq name (ssname ss 0))<br />     (setq a (entget name))<br />     (setq t1 (cdr (assoc 10 a)))<br />     (setq t1ang (cdr (assoc 50 a)))<br />     (setq t1h (cdr (assoc 40 a)))<br />     (setq ppp (polar t1<br />          (+ t1ang (* pi 0.5))<br />          (* t1h 100000)<br />         )<br />     )<br />     (setq i 0)<br />     (setq entlst '())<br />     (repeat (sslength ss)<br />       (setq name (ssname ss i))<br />       (setq a (entget name))<br />       (setq t1 (cdr (assoc 10 a)))<br />       (setq dis (distance t1 ppp))<br />       (setq entlst (append entlst (list (list dis name))))<br />       (setq i (1+ i))<br />     )<br />     (setq entlst (vl-sort<br />        entlst<br />        (function<br />          (lambda (e1 e2)<br />            (< (car e1) (car e2))<br />          )<br />        )<br />      )<br />     )<br /> <br />     (setq sss (ssadd))<br />     (setq i 0)<br />     (repeat (length entlst)<br />       (setq ent (nth i entlst))<br />       (setq sss (ssadd (cadr ent) sss))<br />       (setq i (1+ i))<br />     )<br />     sss<br />   )<br />   (defun textdalig (ss / a ah k name pt1 pt1ang pt2)<br />     (setq name (ssname ss 0))<br />     (setq a (entget name))<br />     (setq pt1 (cdr (assoc 11 a)))<br />     (setq pt1ang (cdr (assoc 50 a)))<br />     (setq ah (* (cdr (assoc 40 a)) texthg))<br />     (setq k 1)<br />     (repeat (1- (sslength ss))<br />       (setq name (ssname ss k))<br />       (setq a (entget name))<br />       (setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))<br />       (setq a (subst (cons 11 pt2) (assoc 11 a) a))<br />       (entmod a)<br />       (setq pt1 pt2)<br />       (setq k (1+ k))<br />     )<br />   )<br />   (defun textdalig0 (ss / a ah k name pt1 pt1ang pt2)<br />     (setq name (ssname ss 0))<br />     (setq a (entget name))<br />     (setq pt1 (cdr (assoc 10 a)))<br />     (setq pt1ang (cdr (assoc 50 a)))<br />     (setq ah (* (cdr (assoc 40 a)) texthg))<br />     (setq k 1)<br />     (repeat (1- (sslength ss))<br />       (setq name (ssname ss k))<br />       (setq a (entget name))<br />       (setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))<br />       (setq a (subst (cons 10 pt2) (assoc 10 a) a))<br />       (entmod a)<br />       (setq pt1 pt2)<br />       (setq k (1+ k))<br />     )<br />   )<br /> <br />   (if (= str nil)<br />     (setq str 1)<br />   )<br />   (if (= texthg nil)<br />     (setq texthg 1.1)<br />   )<br />   (setvar "CMDECHO" 0)<br />   (setq  test T<br />   nn 0<br />   )<br />   (while test<br />     (setq ss (ssadd))<br />     (princ "\n命令zjzs进行设置! \n选择文字:")<br />     (setq ss (ssget '((0 . "TEXT"))))<br />     (if  (= nil ss)<br />       (setq test nil)<br />       (progn<br />   (setq len (sslength ss))<br />   (setq n  1<br />         s  1<br />   )<br />   (cond<br />     ((= str 0)<br />      (while (<= n len)<br />        (setq en1 (ssname ss (1- n)))<br />        (setq a (entget en1))<br />        (if (= "TEXT" (cdr (assoc 0 a)))<br />          (progn<br />      (setq ent (subst (cons 72 str) (assoc 72 a) a))<br />      (setq ent (subst (cons 73 0) (assoc 73 ent) ent))<br />      (entmod ent)<br />          )<br />        )<br />        (setq n (1+ n))<br />      )<br /> <br /> <br /> <br />      (setq ss (textvlsort0 ss))<br />      (textdalig0 ss)<br />     )<br />     (t<br />      (while (<= n len)<br />        (setq en1 (ssname ss (1- n)))<br />        (setq a (entget en1))<br />        (if (= "TEXT" (cdr (assoc 0 a)))<br />          (progn<br />      (setq oldp (cdr (assoc 10 a)))<br />      (setq ent (subst (cons 72 str) (assoc 72 a) a))<br />      (setq ent (subst (cons 73 0) (assoc 73 ent) ent))<br />      (entmod ent)<br />      (setq ent (entget en1))<br />      (setq newp (cdr (assoc 10 ent)))<br />      (setq ptdiv (mapcar '- oldp newp))<br />      (setq pt11 (cdr (assoc 11 ent)))<br />      (setq pt11 (mapcar '+ ptdiv pt11))<br />      (setq ent (subst (cons 11 pt11) (assoc 11 ent) ent))<br />      (entmod ent)<br />          )<br />        )<br />        (setq n (1+ n))<br />      )<br /> <br /> <br /> <br />      (setq ss (textvlsort ss))<br />      (textdalig ss)<br />     )<br />   )<br />       )<br />     )<br />   )<br />   (princ)<br />   )<br />

自贡黄明儒

http://bbs.mjtd.com/thread-107489-1-1.html

lostbalance

自贡黄明儒 发表于 2013-10-28 09:22
http://bbs.mjtd.com/thread-107489-1-1.html

刚刚接触lisp没多久，不是太懂。你给的那个函数，我看着感觉好像也是考虑的插入点。如果是文字对齐点的话，是不是要把assoc 10 en改成assoc 11 en？

llsheng_73

既然文字有多种对齐方式会引起两个完全重合的文字而会有不同的插入点坐标，导致处理起来比较头痛，那为什么不可以考虑通过
(vla-getboundingbox(vlax-ename->vla-object e)'p1 'p2)
   (setq p1(vlax-safearray->list p1)
           p2(vlax-safearray->list p2)
取得它的对角点来计算出中点，以中点作为排序的依据？

llsheng_73

在有的时候，改变文字对齐方式只会引起插入点位置变动，而有的时候插入点它不动，但文字却动了，也是很头痛。。。。

lostbalance

llsheng_73 发表于 2013-10-29 09:46
既然文字有多种对齐方式会引起两个完全重合的文字而会有不同的插入点坐标，导致处理起来比较头痛，那为什么 ...

单纯的考虑中点和考虑插入点差不多吧，比如abc和ab两个text，右对齐点x坐标一样，我认为是同列，但从中点或者插入点来考虑就不算同列了。
设置偏差值可以解决一些问题，但没有直接考虑对齐点来的稳当。
我一直比较好奇，为什么论坛上涉及到文字定位修改的都是用了中间点或者插入点定位，是编程计算方便的缘故吗？

llsheng_73

lostbalance 发表于 2013-10-29 10:21
单纯的考虑中点和考虑插入点差不多吧，比如abc和ab两个text，右对齐点x坐标一样，我认为是同列，但从中点 ...

那样的话你可以考虑用(cdr(assoc 10(entget 文字图元对象名))),刚才查了一下，两个只有对正方式不一样但在图上完全重合的两个文字，它们的组码10是一样的，11就不相同了，那是不是意味着也可以用它来考虑？

其实文字还好一点，对多边形排序更纠结，明显只考虑最左边不行，只考虑中心位置还是不行，那结合起来考虑吧，怎么弄那个算法又头痛了。。。。。纠结了好久好久没有好的办法,看来得发个帖子找高人出手