将文字集合按对齐点坐标排序
这个是明经上递增刷的部分框选代码，作用是文字的选择集按y坐标排序，然后按x坐标排序。对于左对齐的同列文字，x值相同，排序是按y从下到上。但位于其他对齐，比如中间对齐的同列文字，虽然对齐点的x相同，但由于文字长度不同，插入点的x不同，程序就认为是不同的列，导致会因为部分长度较长的文字排序较为靠前。
所以，想求教下如何修改，可以按照文字的对齐点来对文字集合排序。
(setq lst (vl-sort lst (function (lambda
(e1 e2) ; 框选文本先由下到上排序(其它情况自己修改)
(< (cadr (car e1)) (cadr (car e2)))
))))
(setq lst (vl-sort lst (function (lambda
(e1 e2) ; 框选文本后由左到右排序(其它情况自己修改)
(< (car (car e1))
(if (and
(>= (car (car e2)) (- (car (car e1)) txtlong))
(<= (car (car e2)) (+ (car (car e1)) txtlong))
)
(car (car e1))
(car (car e2))
))))))
以前写的，看看吧！还有优化的空间。
(defun c:zjzs (/)
(if (= str nil)
(setq oldstr 1)
(setq oldstr str)
)
(setqstr (getint (strcat "\n0=左对正；1=居中对正；2=右对正<"
(rtos oldstr 2 0)
">:"
)
)
)
(if (= str nil)
(setq str oldstr)
)
(if (= texthg nil)
(setq oldtexthg 1.1)
(setq oldtexthg texthg)
)
(setq
texthg (getreal
(strcat "\n行高与字高的比<" (rtos oldtexthg 2 1) ">:")
)
)
(if (= texthg nil)
(setq texthg oldtexthg)
)
(princ)
)
(DEFUN C:ZZ (/ ss namea t1 t1ang t1hppp i
entlst dise1 e2 sss entpt1 pt1ang
ah k pt2nn len n sen1 oldp
newpptdiv pt11
)
(princ "本工具由孤帆制作！")
(defun textvlsort (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)
(setq name (ssname ss 0))
(setq a (entget name))
(setq t1 (cdr (assoc 11 a)))
(setq t1ang (cdr (assoc 50 a)))
(setq t1h (cdr (assoc 40 a)))
(setq ppp (polar t1
(+ t1ang (* pi 0.5))
(* t1h 100000)
)
)
(setq i 0)
(setq entlst '())
(repeat (sslength ss)
(setq name (ssname ss i))
(setq a (entget name))
(setq t1 (cdr (assoc 11 a)))
(setq dis (distance t1 ppp))
(setq entlst (append entlst (list (list dis name))))
(setq i (1+ i))
)
(setq entlst (vl-sort
entlst
(function
(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(setq sss (ssadd))
(setq i 0)
(repeat (length entlst)
(setq ent (nth i entlst))
(setq sss (ssadd (cadr ent) sss))
(setq i (1+ i))
)
sss
)
(defun textvlsort0 (ss / a dis e1 e2 ent entlst i name ppp sss t1 t1ang t1h)
(setq name (ssname ss 0))
(setq a (entget name))
(setq t1 (cdr (assoc 10 a)))
(setq t1ang (cdr (assoc 50 a)))
(setq t1h (cdr (assoc 40 a)))
(setq ppp (polar t1
(+ t1ang (* pi 0.5))
(* t1h 100000)
)
)
(setq i 0)
(setq entlst '())
(repeat (sslength ss)
(setq name (ssname ss i))
(setq a (entget name))
(setq t1 (cdr (assoc 10 a)))
(setq dis (distance t1 ppp))
(setq entlst (append entlst (list (list dis name))))
(setq i (1+ i))
)
(setq entlst (vl-sort
entlst
(function
(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(setq sss (ssadd))
(setq i 0)
(repeat (length entlst)
(setq ent (nth i entlst))
(setq sss (ssadd (cadr ent) sss))
(setq i (1+ i))
)
sss
)
(defun textdalig (ss / a ah k name pt1 pt1ang pt2)
(setq name (ssname ss 0))
(setq a (entget name))
(setq pt1 (cdr (assoc 11 a)))
(setq pt1ang (cdr (assoc 50 a)))
(setq ah (* (cdr (assoc 40 a)) texthg))
(setq k 1)
(repeat (1- (sslength ss))
(setq name (ssname ss k))
(setq a (entget name))
(setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))
(setq a (subst (cons 11 pt2) (assoc 11 a) a))
(entmod a)
(setq pt1 pt2)
(setq k (1+ k))
)
)
(defun textdalig0 (ss / a ah k name pt1 pt1ang pt2)
(setq name (ssname ss 0))
(setq a (entget name))
(setq pt1 (cdr (assoc 10 a)))
(setq pt1ang (cdr (assoc 50 a)))
(setq ah (* (cdr (assoc 40 a)) texthg))
(setq k 1)
(repeat (1- (sslength ss))
(setq name (ssname ss k))
(setq a (entget name))
(setq pt2 (polar pt1 (- pt1ang (* pi 0.5)) ah))
(setq a (subst (cons 10 pt2) (assoc 10 a) a))
(entmod a)
(setq pt1 pt2)
(setq k (1+ k))
)
)
(if (= str nil)
(setq str 1)
)
(if (= texthg nil)
(setq texthg 1.1)
)
(setvar "CMDECHO" 0)
(setqtest T
nn 0
)
(while test
(setq ss (ssadd))
(princ "\n命令zjzs进行设置! \n选择文字:")
(setq ss (ssget '((0 . "TEXT"))))
(if(= nil ss)
(setq test nil)
(progn
(setq len (sslength ss))
(setq n1
s1
)
(cond
((= str 0)
(while (<= n len)
(setq en1 (ssname ss (1- n)))
(setq a (entget en1))
(if (= "TEXT" (cdr (assoc 0 a)))
(progn
(setq ent (subst (cons 72 str) (assoc 72 a) a))
(setq ent (subst (cons 73 0) (assoc 73 ent) ent))
(entmod ent)
)
)
(setq n (1+ n))
)
(setq ss (textvlsort0 ss))
(textdalig0 ss)
)
(t
(while (<= n len)
(setq en1 (ssname ss (1- n)))
(setq a (entget en1))
(if (= "TEXT" (cdr (assoc 0 a)))
(progn
(setq oldp (cdr (assoc 10 a)))
(setq ent (subst (cons 72 str) (assoc 72 a) a))
(setq ent (subst (cons 73 0) (assoc 73 ent) ent))
(entmod ent)
(setq ent (entget en1))
(setq newp (cdr (assoc 10 ent)))
(setq ptdiv (mapcar '- oldp newp))
(setq pt11 (cdr (assoc 11 ent)))
(setq pt11 (mapcar '+ ptdiv pt11))
(setq ent (subst (cons 11 pt11) (assoc 11 ent) ent))
(entmod ent)
)
)
(setq n (1+ n))
)
(setq ss (textvlsort ss))
(textdalig ss)
)
)
)
)
)
(princ)
)
http://bbs.mjtd.com/thread-107489-1-1.html 自贡黄明儒 发表于 2013-10-28 09:22 static/image/common/back.gif
http://bbs.mjtd.com/thread-107489-1-1.html
刚刚接触lisp没多久，不是太懂。你给的那个函数，我看着感觉好像也是考虑的插入点。如果是文字对齐点的话，是不是要把assoc 10 en改成assoc 11 en？ 既然文字有多种对齐方式会引起两个完全重合的文字而会有不同的插入点坐标，导致处理起来比较头痛，那为什么不可以考虑通过
(vla-getboundingbox(vlax-ename->vla-object e)'p1 'p2)
(setq p1(vlax-safearray->list p1)
p2(vlax-safearray->list p2)
取得它的对角点来计算出中点，以中点作为排序的依据？ 在有的时候，改变文字对齐方式只会引起插入点位置变动，而有的时候插入点它不动，但文字却动了，也是很头痛。。。。 llsheng_73 发表于 2013-10-29 09:46
既然文字有多种对齐方式会引起两个完全重合的文字而会有不同的插入点坐标，导致处理起来比较头痛，那为什么 ...
单纯的考虑中点和考虑插入点差不多吧，比如abc和ab两个text，右对齐点x坐标一样，我认为是同列，但从中点或者插入点来考虑就不算同列了。
设置偏差值可以解决一些问题，但没有直接考虑对齐点来的稳当。
我一直比较好奇，为什么论坛上涉及到文字定位修改的都是用了中间点或者插入点定位，是编程计算方便的缘故吗？ 本帖最后由 llsheng_73 于 2013-10-29 11:29 编辑
lostbalance 发表于 2013-10-29 10:21 static/image/common/back.gif
单纯的考虑中点和考虑插入点差不多吧，比如abc和ab两个text，右对齐点x坐标一样，我认为是同列，但从中点 ...
那样的话你可以考虑用(cdr(assoc 10(entget 文字图元对象名))),刚才查了一下，两个只有对正方式不一样但在图上完全重合的两个文字，它们的组码10是一样的，11就不相同了，那是不是意味着也可以用它来考虑？
其实文字还好一点，对多边形排序更纠结，明显只考虑最左边不行，只考虑中心位置还是不行，那结合起来考虑吧，怎么弄那个算法又头痛了。。。。。纠结了好久好久没有好的办法,看来得发个帖子找高人出手
页:
[1]