社区 › AutoLISP/Visual LISP 编程技术 › n行文字自动按行连接

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

n行文字自动按行连接

本帖最后由 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
            (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.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)
)
(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)
)


http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 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行文字自动按行连接