明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 12370|回复: 31

[源码] 表格内多行的单行文字对齐[左中/中间/右中]

[复制链接]
发表于 2013-12-12 23:50 | 显示全部楼层 |阅读模式
本帖最后由 lostbalance 于 2013-12-19 18:01 编辑

因为工作中要用到材料明细表的关系,一直对表格文字对齐很感兴趣,在论坛下了好几个类似的程序,但总觉得不顺手,而之前水平不足,也编不出像样的程序。
如今在明经论坛泡了小半年,期间下下源码,学习学习各位的经验,感觉收获不小啊,经过几天的编写,终于把表格内多行的单行文字对齐程序完成了。现拿出来,欢迎拍砖。
程序特点:
1. 程序只适用于单行文字,且每个单元格要闭合。这个应该和论坛上类似的程序要求差不多。(当然院长的除外
2. 单个单元格内有多个单行文字的,则上下等分对齐。
3. 只有几个boundary命令,其他基本是数据换算和dxf处理,所有个人觉得资源占用上应该还可以。

2012.12.19 更新1.1版,稍微优化了下共框判断的代码,补上了 (vl-load-com)命令。

  1. ;;表格多行文字对齐[左中/中间/右中]TableMulAlign
  2. ;;v1.0 基本完成 by woyb 20131212
  3. (defun c:TableMulAlign (/ txtss ty lst lst1 lst2 lsti len
  4.         txt txtpt n i leni pxi pyi txtent pt0
  5.         box pts pt1 pt2 px1 py1 px2 py2
  6.       )
  7.   (vl-load-com)
  8.   (princ "\n选择要对齐的文本对象: ")
  9.   (setq txtss (ssget '((0 . "TEXT"))))
  10.   (initget "s d f")
  11.   (setq ty (getkword "\n左中/中间[d]/右中[f]: <d>"))
  12.   (if (not ty) (setq ty "d"))
  13.   (WYB-undob)
  14.   ;建文字列
  15.   (setq lst '() lst1 '() lst2 '() lsti '())
  16.   (setq len (sslength txtss));文字总数
  17.   (repeat (setq n len)
  18.     (setq txt (ssname txtss (setq n (1- n))))
  19.     (setq txtpt (WYB-GetBoxCenter txt))
  20.     (setq lst1 (cons (list txtpt txt) lst1))
  21.   )
  22.   (setq lst1
  23.     (vl-sort lst1
  24.       (function
  25.         (lambda
  26.           (e1 e2)
  27.           (< (cadr (car e1)) (cadr (car e2)))
  28.         )
  29.       )
  30.     )
  31.   )
  32.   (setq leni 0) ;文字计数
  33.   ;共框判断
  34.   (while (/= leni len)
  35.     (setq txt (cadr (car lst1)));首个对象处理
  36.     (setq txtpt (car (car lst1)))
  37.     (setq lst1 (cdr lst1))
  38.     (vl-cmdf "boundary" "a" "o" "p" "" txtpt "")
  39.     (setq box (entlast));表格框
  40.     (setq pts (WYB-GetBox box))
  41.     (entdel box)
  42.     (setq pt1 (car pts) pt2 (cadr pts));表格框的点坐标
  43.     (setq px1 (car pt1) py1 (cadr pt1))
  44.     (setq px2 (car pt2) py2 (cadr pt2))
  45.     (setq lsti (cons (list px1 py1 px2 py2) lsti)) ;框坐标入共框列
  46.     (setq lsti (cons txt lsti)) ;文字入共框列
  47.     (setq leni (1+ leni))
  48.     (while (/= lst1 nil)
  49.       (setq txt (cadr (car lst1)));第二个对象处理
  50.       (setq txtpt (car (car lst1)))
  51.       (setq lst1 (cdr lst1))
  52.       (setq pxi (car txtpt) pyi (cadr txtpt));文字中心点坐标
  53.       (if (and (> pxi px1) (> pyi py1) (< pxi px2) (< pyi py2))
  54.         (progn ;共框,入共框列
  55.           (setq lsti (cons txt lsti))
  56.           (setq leni (1+ leni))
  57.         )
  58.         (progn
  59.         (setq lst2 (cons (list txtpt txt) lst2)) ;不共框,入临时列
  60.         )
  61.       )
  62.     )
  63.     (setq lsti (reverse lsti))
  64.     (setq lst2 (reverse lst2))
  65.     (setq lst (cons lsti lst)) ;共框列入列合集
  66.     (setq lst1 lst2) ;非共框文字列返回
  67.     (setq lst2 '())
  68.     (setq lsti '())
  69.   )
  70.   (repeat (length lst) ;列集合循环
  71.     (setq lsti (car lst))
  72.     (setq lst (cdr lst))
  73.     (setq pts (car lsti))
  74.     (setq lsti (cdr lsti))
  75.     (setq px1 (nth 0 pts) py1 (nth 1 pts))
  76.     (setq px2 (nth 2 pts) py2 (nth 3 pts))
  77.     (setq n (length lsti) i 0)
  78.     (setq py (/ (- py2 py1) n))
  79.     (repeat n ;共框列循环
  80.       (setq tx (car lsti))
  81.       (setq lsti (cdr lsti))
  82.       (setq txtent (entget tx))
  83.       (cond
  84.         ((= ty "s");左中
  85.           (progn
  86.             (setq txtent (subst (cons 72 0) (assoc 72 txtent) txtent))
  87.             (setq txtent (subst (cons 73 2) (assoc 73 txtent) txtent))
  88.             (setq pt0 (list (+ px1 1) (+ (* py (+ i 0.5)) py1) 0))
  89.             (setq i (1+ i))
  90.             (setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
  91.           )
  92.         )
  93.         ((= ty "d");中间
  94.           (progn
  95.             (setq txtent (subst (cons 72 4) (assoc 72 txtent) txtent))
  96.             (setq txtent (subst (cons 73 0) (assoc 73 txtent) txtent))
  97.             (setq pt0 (list (* (+ px1 px2) 0.5) (+ (* py (+ i 0.5)) py1) 0))
  98.             (setq i (1+ i))
  99.             (setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
  100.           )
  101.         )
  102.         ((= ty "f");右中
  103.           (progn
  104.             (setq txtent (subst (cons 72 2) (assoc 72 txtent) txtent))
  105.             (setq txtent (subst (cons 73 2) (assoc 73 txtent) txtent))
  106.             (setq pt0 (list (- px2 1) (+ (* py (+ i 0.5)) py1) 0))
  107.             (setq i (1+ i))
  108.             (setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
  109.           )
  110.         )
  111.       )
  112.       (entmod txtent)
  113.     )
  114.   )
  115.   (WYB-undoe)
  116.   (princ "\n操作完成")
  117.   (princ)
  118. )
  119. ;;;;;;;;;;;;;;;;;;;;
  120. ;; 获取对象正中点
  121. ;;(WYB-GetBoxCenter 对象)
  122. (defun WYB-GetBoxCenter (e / obj minpoint maxpoint)
  123.     (if (= 'ENAME (type e))
  124.         (setq obj (vlax-ename->vla-object e)) ;转换图元名
  125.         (setq obj e)
  126.     )
  127.     (vla-GetBoundingBox obj 'minpoint 'maxpoint) ;取得包容图元的最大点和最小点
  128.     (setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
  129.     (setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
  130.     (setq p (mapcar '+ minpoint maxpoint))
  131.     (mapcar '(lambda (x) (* 0.5 x)) p)
  132. )
  133. ;;;;;;;;;;;;;;;;;;;;
  134. ;;取得对象外矩形框
  135. ;;By Longxin 明经通道 2005.06
  136. ;;(WYB-GetBox 对象)
  137. ;;返回: ((x1 y1 z1)_min (x2 y2 z2)_max)
  138. (defun WYB-GetBox (e / obj minpoint maxpoint)
  139.     (if (= 'ENAME (type e))
  140.         (setq obj (vlax-ename->vla-object e)) ;转换图元名
  141.         (setq obj e)
  142.     )
  143.     (vla-GetBoundingBox obj 'minpoint 'maxpoint) ;取得包容图元的最大点和最小点
  144.     (setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
  145.     (setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
  146.     (setq obj (list minpoint maxpoint))
  147. )
  148. ;;;;;;;;;;;;;;;;;;;;
  149. ;;关命令响应,开始undo
  150. ;;(WYB-undob)
  151. (defun WYB-undob()
  152.     (setvar "cmdecho" 0)
  153.     (command ".undo" "be")
  154. )
  155. ;;;;;;;;;;;;;;;;;;;;
  156. ;;开启命令相应,结束undo
  157. ;;(WYB-undoe)
  158. (defun WYB-undoe()
  159.     (command ".undo" "e")
  160.     (setvar "cmdecho" 1)
  161. )




本帖子中包含更多资源

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

x

评分

参与人数 1明经币 +1 收起 理由
ucuc2003 + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2018-1-13 21:51 | 显示全部楼层
感谢题主分享,工具挺好用的。看图片圆圈里,d,s都有,但是缺了f。还有想请教下,圆圈里的那个菜单是怎么实现的?
建议:实际使用中,如果表格框比较大,字比较小,使用后会导致两个字之间行间距过大。可否增加控制行间距为字高的几分之一?

本帖子中包含更多资源

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

x
发表于 2022-1-4 15:17 | 显示全部楼层
lostbalance 发表于 2014-8-26 22:53
影响运行的主要就是判断文字框的boundary命令。lisp中调用cad的command命效率都很低,除非找到其他的 ...

楼主 ,这么多年了。这程序可能把兼容性提高点?大部分图都没问题,就是部分图会假死。
发表于 2017-12-15 10:10 | 显示全部楼层
楼主能不能把多行文字也考虑进去呀,光是单行文字的话是完美的,但是表格里可能同时夹杂着多行文字和单行文字!
发表于 2013-12-13 00:32 | 显示全部楼层
谢谢分享,下载学习
发表于 2013-12-13 08:56 | 显示全部楼层
最后一个选项,[右中]对齐,你实际工作中遇到过吗?我认为前两个选项就够了。如果非要最后一个选项,可以[左中对齐],然后mirror一下。
 楼主| 发表于 2013-12-13 11:07 来自手机 | 显示全部楼层
自贡黄明儒 发表于 2013-12-13 08:56
最后一个选项,[右中]对齐,你实际工作中遇到过吗?我认为前两个选项就够了。如果非要最后一个选项,可以[左 ...

右中确实用不上。只不过是最后顺手加了这个功能。确实用不上的话,可以把cond里面的几行删掉,对整个程序没有影响。另外的对齐方式,也是在cond里面相应增加就可以了。
ps,非常感谢你编的通用排序函数和函数库,很好用。另外,请问下,那个通用排序涉及到多维的时候如何处理各维偏差值不一样的情况。

点评

最多三维,偏差不同的话,你只能改程序  发表于 2013-12-13 11:11
发表于 2013-12-13 19:48 | 显示全部楼层
能改改支持天正文字么?吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mo ... ;pre_pos=1&ext=
发表于 2013-12-13 23:29 | 显示全部楼层
程序是不错,似乎运行速度慢了些。
发表于 2013-12-14 02:16 | 显示全部楼层
好東西, 謝謝分享
 楼主| 发表于 2013-12-14 09:57 | 显示全部楼层
bai2000 发表于 2013-12-13 19:48
能改改支持天正文字么?吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101931&re ...

可能行业的关系,都没见过天正的东西,所以没头绪。
不过如果知道组码的话,可以在以下几处改一下,
1.  开始选取类型中加上该类型,
2. 在最后循环更改对齐组码和定位中按照对应的组码更改
3. 考虑到组码与text不同的可能性较大,还要加个判断分类的cond。
 楼主| 发表于 2013-12-14 10:17 | 显示全部楼层
香田里浪人 发表于 2013-12-13 23:29
程序是不错,似乎运行速度慢了些。

嗯,这个是硬伤。程序编完后想了想了下,一开始的y排序因为是最后加上的,但如果按后面的处理,这个并没有起什么作用。现在考虑共框判断时先用y判断下,超范围直接进行下一个框的判断。
我觉得最影响速度的还是boundary命令,不知道cad是如何运行这个命令,感觉这个命令特别的慢。你可以试一下同样一个表格,在屏幕上同样的大小,周围有图和没有图两种情况下的运行速度,差别很大啊。我觉得在对齐的时候,把要整理的表格文字尽可能的放大到屏幕中,不相干的图越少越好。
发表于 2013-12-14 12:17 | 显示全部楼层
上传天正文字  表格样板

本帖子中包含更多资源

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

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 21:05 , Processed in 0.364734 second(s), 40 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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