请教各位大神，这个文字合并程序怎么加个X方向距离限制？距离外的单独合并

听见天晴 · 发表于 2024-6-29 23:05:58

本帖最后由听见天晴于 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
(sstext nscale / n rtnlst
y rtnlst1 rtnlst2 space1 space2
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)
)
(setq sslst (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
)
(setq sslst (apply 'append
(mapcar 'cdr
sslst
)
)
)
(foreach n sslst
(entdel n)
)
(vla-endundomark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ "\n文字合并结束!")
(princ)
)

(defun c:WE (/ sort_text_by_column1 sslst textlst scale) 
  ;;按行排列文字,nscale为字高的倍数，设为0.5，即文字竖向间距小于0.5倍字高，则按一行考虑 
  (defun sort_text_by_column1 
            (sstext  nscale  /       n       rtnlst 
             y       rtnlst1 rtnlst2 space1  space2 
             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) 
  ) 
  (setq  sslst  (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 
  ) 
  (setq  sslst (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 00:20:41

本帖最后由你有种再说一遍于 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 11:37:11

你有种再说一遍发表于 2024-6-30 00:20
哈哈,这个对于你来说还是太难了.
如果敲lisp的大概率会想同一行超过多少就认为是另一组文字,
然后这个距 ...

就是不会啊，看看有没有大神帮忙改一下

kozmosovia · 发表于 2024-6-30 13:20:39

同行文字按照包围盒X排序，然后顺次计算前后包围盒的间距，大于指定距离就分隔。相当于根据包围盒间距分组。

你有种再说一遍 · 发表于 2024-6-30 17:21:09

听见天晴发表于 2024-6-30 11:37
就是不会啊，看看有没有大神帮忙改一下

自己动手丰衣足食,哪有人天天帮你改呢

咏郡 · 发表于 2024-6-30 19:00:26

为什么不弄两次呢

听见天晴 · 发表于 2024-6-30 21:10:21

咏郡发表于 2024-6-30 19:00
为什么不弄两次呢

可以弄多次，但是一次更方便

听见天晴 · 发表于 2024-6-30 21:30:47

kozmosovia 发表于 2024-6-30 13:20
同行文字按照包围盒X排序，然后顺次计算前后包围盒的间距，大于指定距离就分隔。相当于根据包围盒间距分组 ...

谢谢，我不太会，去试试~

jun470 · 发表于 2024-7-1 12:04:52

点进来以为能说的上话，其实我也不懂，哈哈哈

账号		自动登录	找回密码
密码			注册

[提问] 请教各位大神，这个文字合并程序怎么加个X方向距离限制？距离外的单独合并

本帖子中包含更多资源