请教各位大神，这个文字合并程序怎么加个X方向距离限制？距离外的单独合并
本帖最后由 听见天晴 于 2024-6-29 23:07 编辑以下是论坛下载的程序，作用的合并单行/多行文字，合并后可以保持原行。
目前文字距离很大的一起选中也会合并到一起，希望大神修改下，添加一个X方向距离限制，文字之间距离小于多少的才和并到一起，大于多少的独立自行合并，距离大的一般在不同图框里的，只需要同一个图框里的那些字合并在一起就好，目前是程序只要在同一行，就会合在一起，请大神帮忙修改一下程序，谢谢!
(defun c:WE (/ sort_text_by_column1 sslst textlst scale)
;;按行排列文字,nscale为字高的倍数，设为0.5，即文字竖向间距小于0.5倍字高，则按一行考虑
(defun sort_text_by_column1
(sstextnscale/ n rtnlst
y rtnlst1 rtnlst2 space1space2
aa bb cc dd
)
(setq n -1
rtnlst nil
)
(repeat (sslength sstext)
(setq rtnlst (cons (ssname sstext (setq n (1+ n))) rtnlst))
)
(setq rtnlst
(vl-sort
rtnlst
'(lambda (a b)
(setq a(vlax-ename->vla-object a)
b(vlax-ename->vla-object b)
)
(vla-GetBoundingBox a 'aa 'bb)
(vla-GetBoundingBox b 'cc 'dd)
(if
(< (abs (- (vlax-safearray-get-element aa 1)
(vlax-safearray-get-element cc 1)
)
)
(abs
(* nscale
(- (vlax-safearray-get-element bb 1)
(vlax-safearray-get-element aa 1)
)
)
)
)
(< (vlax-safearray-get-element aa 0)
(vlax-safearray-get-element cc 0)
)
(> (vlax-safearray-get-element aa 1)
(vlax-safearray-get-element cc 1)
)
)
)
)
)
(setq y (cadr (zgx-get-dxf 10 (car rtnlst) 1)))
(setq rtnlst1 nil
rtnlst2 nil
)
(mapcar
'(lambda (x)
(vla-GetBoundingBox (vlax-ename->vla-object x) 'aa 'bb)
(if
(< (abs (- (cadr (zgx-get-dxf 10 x 1)) y))
(* nscale
(abs (- (vlax-safearray-get-element bb 1)
(vlax-safearray-get-element aa 1)
)
)
)
)
(progn
(setq rtnlst1 (append rtnlst1 (list x)))
)
(progn
(setq rtnlst2 (append rtnlst2 (list rtnlst1)))
(setq y (cadr (zgx-get-dxf 10 x 1)))
(setq rtnlst1 nil
rtnlst1 (append rtnlst1 (list x))
)
)
)
)
rtnlst
)
(setq rtnlst2 (append rtnlst2 (list rtnlst1)))
)
;;----------------------------------------------
(defun zgx-chg-dxf (en code newdata / endata)
(setq endata (entget en))
(if(assoc code endata)
(setq
endata (subst (cons code newdata) (assoc code endata) endata)
)
(setq
endata (append endata (list (cons code newdata)))
)
)
(entmod endata)
)
(defun zgx-get-dxf (code entname kk)
(if(= kk 2)
(assoc code (entget entname))
(cdr (assoc code (entget entname)))
)
)
;;----------------------------------------------
(prompt "\n选择需要合并的文字[更改间距系数]:")
(setq sslst (ssget '((0 . "TEXT,MTEXT"))))
(while (not sslst)
(setq scale (getreal "\n输入间距系数[默认0.5]:"))
(if(not scale)
(setq scale 0.5)
)
(prompt "\n选择需要合并的文字[更改间距系数]:")
(setq sslst (ssget '((0 . "TEXT,MTEXT"))))
)
(if (not scale)
(setq scale 0.5)
)
(setqsslst(sort_text_by_column1 sslst scale)
textlst(mapcar'(lambda (c)
(apply 'strcat c)
)
(mapcar'(lambda (x)
(mapcar '(lambda (a)
(zgx-get-dxf 1 a 1)
)
x
)
)
sslst
)
)
)
(vla-startundomark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
;;改变每行第一个文字值
(mapcar '(lambda (a b)
(zgx-chg-dxf (car a) 1 b)
)
sslst
textlst
)
(setqsslst (apply 'append
(mapcar 'cdr
sslst
)
)
)
(foreach n sslst
(entdel n)
)
(vla-endundomark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ "\n文字合并结束!")
(princ)
)
本帖最后由 你有种再说一遍 于 2024-6-30 01:49 编辑
哈哈,这个对于你来说还是太难了.
如果敲lisp的大概率会想同一行超过多少就认为是另一组文字,
然后这个距离由用户自己输入.
最简单就是包围盒距离,简单说就是rect1.right到rect2.left
如果敲net/c++的想,怎么自适应这个全局分堆,分堆就自然是另一行.
你扩展了14#问题了,加油
http://bbs.mjtd.com/thread-187082-2-1.html
你有种再说一遍 发表于 2024-6-30 00:20
哈哈,这个对于你来说还是太难了.
如果敲lisp的大概率会想同一行超过多少就认为是另一组文字,
然后这个距 ...
就是不会啊，看看有没有大神帮忙改一下 同行文字按照包围盒X排序，然后顺次计算前后包围盒的间距，大于指定距离就分隔。相当于根据包围盒间距分组。 听见天晴 发表于 2024-6-30 11:37
就是不会啊，看看有没有大神帮忙改一下
自己动手丰衣足食,哪有人天天帮你改呢 为什么不弄两次呢 咏郡 发表于 2024-6-30 19:00
为什么不弄两次呢
可以弄多次，但是一次更方便 kozmosovia 发表于 2024-6-30 13:20
同行文字按照包围盒X排序，然后顺次计算前后包围盒的间距，大于指定距离就分隔。相当于根据包围盒间距分组 ...
谢谢，我不太会，去试试~ 点进来以为能说的上话，其实我也不懂，哈哈哈
页:
[1]