求大神看下文字合并的问题，如图有文字都是断开的，如何框选使用文字能合并
本帖最后由 664571221 于 2018-8-8 10:07 编辑求大神看下文字合并的问题，如图有文字都是断开的，如何框选使用文字能合并
文字合并，这个可以参考，这个其它网友的源码！
;;按行排列文字,nscale为字高的倍数，设为0.8，即文字竖向间距小于0.5倍字高，则按一行考虑
(defun c:qnn (/ sort_text_by_column1 sslst textlst scale)
(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,swr_text"))))
(while (not sslst)
(setq scale (getreal "\n输入间距系数[默认0.8]:"))
(if(not scale)
(setq scale 0.8)
)
(prompt "\n选择需要合并的文字[更改间距系数]:")
(setq sslst (ssget '((0 . "text,swr_text,tch_text"))))
)
(if (not scale)
(setq scale 0.8)
)
(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)
) 小毛草 发表于 2022-7-21 17:06
文字合并，这个可以参考，这个其它网友的源码！
请问Y向的怎么合并不了 meja 发表于 2019-1-6 16:15
lee mac大神给我编了一个
你好大神在吗可以加下我qq吗 定制程序。以前做过。 lee mac大神给我编了一个 meja 发表于 2019-1-6 16:15
lee mac大神给我编了一个
能发个我吗 664571221@qq.com 947198446可以做
QWQWQWQ 发表于 2021-12-24 11:27
947198446可以做
加不上有问题 同求，可付费 my_autocad 发表于 2022-7-6 22:08
同求，可付费
兄弟加我3298554767
页:
[1]
2