n行文字自动按行连接

brainstorm · 发表于 2012-1-27 10:52:24

本帖最后由 brainstorm 于 2012-1-27 11:17 编辑

(defun c:wzlj (/ 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,swr_text"))))
(while (not sslst)
(setq scale (getreal "\n输入间距系数[默认0.5]:"))
(if (not scale)
(setq scale 0.5)
)
(prompt "\n选择需要合并的文字[更改间距系数]:")
(setq sslst (ssget '((0 . "text,swr_text,tch_text"))))
)
(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:wzlj (/ 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,swr_text")))) 
 
  (while (not sslst) 
    (setq scale (getreal "\n输入间距系数[默认0.5]:")) 
    (if  (not scale) 
      (setq scale 0.5) 
    ) 
    (prompt "\n选择需要合并的文字[更改间距系数]:") 
    (setq sslst (ssget '((0 . "text,swr_text,tch_text")))) 
  ) 
 
  (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) 
)

该贴已经同步到 brainstorm的微博

KO你 · 发表于 2020-2-24 01:36:07

只限于XY轴的，有没有倾斜的也可以合并的，求大师完善

疯球 · 发表于 2018-6-3 16:34:26

谢谢分享，但是：错误，输入的字符串太长是什么意思？

leon904828888 · 发表于 2020-10-17 17:56:53

很实用的功能，楼主的这个命令设计的很实用

langjs · 发表于 2012-1-27 11:52:06

谢谢分享源码

hpy · 发表于 2012-1-27 13:04:32

比较有用，感谢分享！

byghbcx · 发表于 2012-1-27 14:10:02

新年还忙着编程，好同志呀

yoyoho · 发表于 2012-1-27 20:40:08

感谢 brainstorm 楼主分享程序!

szx025 · 发表于 2012-1-28 09:08:25

如果再增加一个判断，鼠标左键让每行连接的文字中间能有一空格，鼠标右键执行原程序，就更好了

669423907 · 发表于 2012-1-28 16:16:46

谢谢楼主分享好程序！

longer1000 · 发表于 2012-1-29 14:08:32

谢谢楼主分享

429014673 · 发表于 2012-1-29 15:26:41

手机看不了源码。。。？？？？？5555555

429014673 · 发表于 2012-1-29 15:28:04

手机看不了源码。。。？？？？？5555555

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

n行文字自动按行连接

本帖子中包含更多资源

评分