明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 11101|回复: 55

n行文字自动按行连接

    [复制链接]
发表于 2012-1-27 10:52 | 显示全部楼层 |阅读模式
本帖最后由 brainstorm 于 2012-1-27 11:17 编辑
  1. (defun c:wzlj (/ sort_text_by_column1 sslst textlst scale)
  2.   ;;按行排列文字,nscale为字高的倍数,设为0.5,即文字竖向间距小于0.5倍字高,则按一行考虑
  3.   (defun sort_text_by_column1
  4.             (sstext  nscale  /       n       rtnlst
  5.              y       rtnlst1 rtnlst2 space1  space2
  6.              aa      bb      cc      dd
  7.             )
  8.     (setq n -1
  9.     rtnlst nil
  10.     )
  11.     (repeat (sslength sstext)
  12.       (setq rtnlst (cons (ssname sstext (setq n (1+ n))) rtnlst))
  13.     )
  14.     (setq rtnlst
  15.      (vl-sort
  16.        rtnlst
  17.        '(lambda (a b)
  18.     (setq a  (vlax-ename->vla-object a)
  19.           b  (vlax-ename->vla-object b)
  20.     )
  21.     (vla-GetBoundingBox a 'aa 'bb)
  22.     (vla-GetBoundingBox b 'cc 'dd)
  23.     (if
  24.       (< (abs (- (vlax-safearray-get-element aa 1)
  25.            (vlax-safearray-get-element cc 1)
  26.         )
  27.          )
  28.          (abs
  29.            (* nscale
  30.         (- (vlax-safearray-get-element bb 1)
  31.            (vlax-safearray-get-element aa 1)
  32.         )
  33.            )
  34.          )
  35.       )
  36.        (< (vlax-safearray-get-element aa 0)
  37.           (vlax-safearray-get-element cc 0)
  38.        )
  39.        (> (vlax-safearray-get-element aa 1)
  40.           (vlax-safearray-get-element cc 1)
  41.        )
  42.     )
  43.         )
  44.      )
  45.     )
  46.     (setq y (cadr (zgx-get-dxf 10 (car rtnlst) 1)))
  47.     (setq rtnlst1 nil
  48.     rtnlst2 nil
  49.     )
  50.     (mapcar
  51.       '(lambda (x)
  52.    (vla-GetBoundingBox (vlax-ename->vla-object x) 'aa 'bb)
  53.    (if
  54.      (< (abs (- (cadr (zgx-get-dxf 10 x 1)) y))
  55.         (* nscale
  56.      (abs (- (vlax-safearray-get-element bb 1)
  57.        (vlax-safearray-get-element aa 1)
  58.           )
  59.      )
  60.         )
  61.      )
  62.       (progn
  63.         (setq rtnlst1 (append rtnlst1 (list x)))
  64.       )
  65.       (progn
  66.         (setq rtnlst2 (append rtnlst2 (list rtnlst1)))
  67.         (setq y (cadr (zgx-get-dxf 10 x 1)))
  68.         (setq rtnlst1 nil
  69.         rtnlst1 (append rtnlst1 (list x))
  70.         )
  71.       )
  72.    )
  73.        )
  74.       rtnlst
  75.     )
  76.     (setq rtnlst2 (append rtnlst2 (list rtnlst1)))
  77.   )
  78.   ;;----------------------------------------------
  79.   (defun zgx-chg-dxf (en code newdata / endata)
  80.     (setq endata (entget en))
  81.     (if  (assoc code endata)
  82.       (setq
  83.   endata (subst (cons code newdata) (assoc code endata) endata)
  84.       )
  85.       (setq
  86.   endata (append endata (list (cons code newdata)))
  87.       )
  88.     )
  89.     (entmod endata)
  90.   )
  91.   (defun zgx-get-dxf (code entname kk)
  92.     (if  (= kk 2)
  93.       (assoc code (entget entname))
  94.       (cdr (assoc code (entget entname)))
  95.     )
  96.   )
  97.   ;;----------------------------------------------
  98.   (prompt "\n选择需要合并的文字[更改间距系数]:")
  99.   (setq sslst (ssget '((0 . "text,swr_text"))))

  100.   (while (not sslst)
  101.     (setq scale (getreal "\n输入间距系数[默认0.5]:"))
  102.     (if  (not scale)
  103.       (setq scale 0.5)
  104.     )
  105.     (prompt "\n选择需要合并的文字[更改间距系数]:")
  106.     (setq sslst (ssget '((0 . "text,swr_text,tch_text"))))
  107.   )

  108.   (if (not scale)
  109.     (setq scale 0.5)
  110.   )
  111.   (setq  sslst  (sort_text_by_column1 sslst scale)
  112.   textlst  (mapcar  '(lambda (c)
  113.          (apply 'strcat c)
  114.        )
  115.       (mapcar  '(lambda (x)
  116.            (mapcar '(lambda (a)
  117.                 (zgx-get-dxf 1 a 1)
  118.               )
  119.              x
  120.            )
  121.          )
  122.         sslst
  123.       )
  124.     )
  125.   )
  126.   (vla-startundomark
  127.     (vla-get-ActiveDocument (vlax-get-acad-object))
  128.   )
  129.   ;;改变每行第一个文字值
  130.   (mapcar '(lambda (a b)
  131.        (zgx-chg-dxf (car a) 1 b)
  132.      )
  133.     sslst
  134.     textlst
  135.   )
  136.   (setq  sslst (apply 'append
  137.          (mapcar 'cdr
  138.            sslst
  139.          )
  140.         )
  141.   )
  142.   (foreach n sslst
  143.     (entdel n)
  144.   )
  145.   (vla-endundomark
  146.     (vla-get-ActiveDocument (vlax-get-acad-object))
  147.   )
  148.   (princ "\n文字合并结束!")
  149.   (princ)
  150. )



该贴已经同步到 brainstorm的微博

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 3明经币 +3 收起 理由
magicheno + 1 很给力!
vlisp2012 + 1
langjs + 1

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2020-2-24 01:36 | 显示全部楼层
只限于XY轴的,有没有倾斜的也可以合并的,求大师完善
发表于 2018-6-3 16:34 | 显示全部楼层
谢谢分享,但是:错误,输入的字符串太长是什么意思?
发表于 2020-10-17 17:56 | 显示全部楼层
很实用的功能,楼主的这个命令设计的很实用
发表于 2012-1-27 11:52 | 显示全部楼层
谢谢分享源码
发表于 2012-1-27 13:04 | 显示全部楼层
比较有用,感谢分享!
发表于 2012-1-27 14:10 | 显示全部楼层
新年还忙着编程,好同志呀
发表于 2012-1-27 20:40 | 显示全部楼层
感谢 brainstorm 楼主分享程序!
发表于 2012-1-28 09:08 | 显示全部楼层
如果再增加一个判断,鼠标左键让每行连接的文字中间能有一空格,鼠标右键执行原程序,就更好了
发表于 2012-1-28 16:16 | 显示全部楼层
谢谢楼主分享好程序!
发表于 2012-1-29 14:08 | 显示全部楼层
谢谢楼主分享
发表于 2012-1-29 15:26 来自手机 | 显示全部楼层
手机看不了源码。。。?????5555555
发表于 2012-1-29 15:28 来自手机 | 显示全部楼层
手机看不了源码。。。?????5555555
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 13:03 , Processed in 0.289641 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表