表格内多行的单行文字对齐[左中/中间/右中]
本帖最后由 lostbalance 于 2013-12-19 18:01 编辑因为工作中要用到材料明细表的关系，一直对表格文字对齐很感兴趣，在论坛下了好几个类似的程序，但总觉得不顺手，而之前水平不足，也编不出像样的程序。
如今在明经论坛泡了小半年，期间下下源码，学习学习各位的经验，感觉收获不小啊，经过几天的编写，终于把表格内多行的单行文字对齐程序完成了。现拿出来，欢迎拍砖。
程序特点：
1. 程序只适用于单行文字，且每个单元格要闭合。这个应该和论坛上类似的程序要求差不多。（当然院长的除外）
2. 单个单元格内有多个单行文字的，则上下等分对齐。
3. 只有几个boundary命令，其他基本是数据换算和dxf处理，所有个人觉得资源占用上应该还可以。
2012.12.19 更新1.1版，稍微优化了下共框判断的代码，补上了 (vl-load-com)命令。
;;表格多行文字对齐[左中/中间/右中]TableMulAlign
;;v1.0 基本完成 by woyb 20131212
(defun c:TableMulAlign (/ txtss ty lst lst1 lst2 lsti len
txt txtpt n i leni pxi pyi txtent pt0
box pts pt1 pt2 px1 py1 px2 py2
)
(vl-load-com)
(princ "\n选择要对齐的文本对象: ")
(setq txtss (ssget '((0 . "TEXT"))))
(initget "s d f")
(setq ty (getkword "\n左中/中间/右中: <d>"))
(if (not ty) (setq ty "d"))
(WYB-undob)
;建文字列
(setq lst '() lst1 '() lst2 '() lsti '())
(setq len (sslength txtss));文字总数
(repeat (setq n len)
(setq txt (ssname txtss (setq n (1- n))))
(setq txtpt (WYB-GetBoxCenter txt))
(setq lst1 (cons (list txtpt txt) lst1))
)
(setq lst1
(vl-sort lst1
(function
(lambda
(e1 e2)
(< (cadr (car e1)) (cadr (car e2)))
)
)
)
)
(setq leni 0) ;文字计数
;共框判断
(while (/= leni len)
(setq txt (cadr (car lst1)));首个对象处理
(setq txtpt (car (car lst1)))
(setq lst1 (cdr lst1))
(vl-cmdf "boundary" "a" "o" "p" "" txtpt "")
(setq box (entlast));表格框
(setq pts (WYB-GetBox box))
(entdel box)
(setq pt1 (car pts) pt2 (cadr pts));表格框的点坐标
(setq px1 (car pt1) py1 (cadr pt1))
(setq px2 (car pt2) py2 (cadr pt2))
(setq lsti (cons (list px1 py1 px2 py2) lsti)) ;框坐标入共框列
(setq lsti (cons txt lsti)) ;文字入共框列
(setq leni (1+ leni))
(while (/= lst1 nil)
(setq txt (cadr (car lst1)));第二个对象处理
(setq txtpt (car (car lst1)))
(setq lst1 (cdr lst1))
(setq pxi (car txtpt) pyi (cadr txtpt));文字中心点坐标
(if (and (> pxi px1) (> pyi py1) (< pxi px2) (< pyi py2))
(progn ;共框，入共框列
(setq lsti (cons txt lsti))
(setq leni (1+ leni))
)
(progn
(setq lst2 (cons (list txtpt txt) lst2)) ;不共框，入临时列
)
)
)
(setq lsti (reverse lsti))
(setq lst2 (reverse lst2))
(setq lst (cons lsti lst)) ;共框列入列合集
(setq lst1 lst2) ;非共框文字列返回
(setq lst2 '())
(setq lsti '())
)
(repeat (length lst) ;列集合循环
(setq lsti (car lst))
(setq lst (cdr lst))
(setq pts (car lsti))
(setq lsti (cdr lsti))
(setq px1 (nth 0 pts) py1 (nth 1 pts))
(setq px2 (nth 2 pts) py2 (nth 3 pts))
(setq n (length lsti) i 0)
(setq py (/ (- py2 py1) n))
(repeat n ;共框列循环
(setq tx (car lsti))
(setq lsti (cdr lsti))
(setq txtent (entget tx))
(cond
((= ty "s");左中
(progn
(setq txtent (subst (cons 72 0) (assoc 72 txtent) txtent))
(setq txtent (subst (cons 73 2) (assoc 73 txtent) txtent))
(setq pt0 (list (+ px1 1) (+ (* py (+ i 0.5)) py1) 0))
(setq i (1+ i))
(setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
)
)
((= ty "d");中间
(progn
(setq txtent (subst (cons 72 4) (assoc 72 txtent) txtent))
(setq txtent (subst (cons 73 0) (assoc 73 txtent) txtent))
(setq pt0 (list (* (+ px1 px2) 0.5) (+ (* py (+ i 0.5)) py1) 0))
(setq i (1+ i))
(setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
)
)
((= ty "f");右中
(progn
(setq txtent (subst (cons 72 2) (assoc 72 txtent) txtent))
(setq txtent (subst (cons 73 2) (assoc 73 txtent) txtent))
(setq pt0 (list (- px2 1) (+ (* py (+ i 0.5)) py1) 0))
(setq i (1+ i))
(setq txtent (subst (cons 11 pt0) (assoc 11 txtent) txtent))
)
)
)
(entmod txtent)
)
)
(WYB-undoe)
(princ "\n操作完成")
(princ)
)
;;;;;;;;;;;;;;;;;;;;
;; 获取对象正中点
;;(WYB-GetBoxCenter 对象)
(defun WYB-GetBoxCenter (e / obj minpoint maxpoint)
(if (= 'ENAME (type e))
(setq obj (vlax-ename->vla-object e)) ;转换图元名
(setq obj e)
)
(vla-GetBoundingBox obj 'minpoint 'maxpoint) ;取得包容图元的最大点和最小点
(setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
(setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
(setq p (mapcar '+ minpoint maxpoint))
(mapcar '(lambda (x) (* 0.5 x)) p)
)
;;;;;;;;;;;;;;;;;;;;
;;取得对象外矩形框
;;By Longxin 明经通道 2005.06
;;(WYB-GetBox 对象)
;;返回: ((x1 y1 z1)_min (x2 y2 z2)_max)
(defun WYB-GetBox (e / obj minpoint maxpoint)
(if (= 'ENAME (type e))
(setq obj (vlax-ename->vla-object e)) ;转换图元名
(setq obj e)
)
(vla-GetBoundingBox obj 'minpoint 'maxpoint) ;取得包容图元的最大点和最小点
(setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
(setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
(setq obj (list minpoint maxpoint))
)
;;;;;;;;;;;;;;;;;;;;
;;关命令响应，开始undo
;;(WYB-undob)
(defun WYB-undob()
(setvar "cmdecho" 0)
(command ".undo" "be")
)
;;;;;;;;;;;;;;;;;;;;
;;开启命令相应，结束undo
;;(WYB-undoe)
(defun WYB-undoe()
(command ".undo" "e")
(setvar "cmdecho" 1)
)
感谢题主分享，工具挺好用的。看图片圆圈里，d，s都有，但是缺了f。还有想请教下，圆圈里的那个菜单是怎么实现的？
建议：实际使用中，如果表格框比较大，字比较小，使用后会导致两个字之间行间距过大。可否增加控制行间距为字高的几分之一？
lostbalance 发表于 2014-8-26 22:53
影响运行的主要就是判断文字框的boundary命令。lisp中调用cad的command命效率都很低，除非找到其他的 ...
楼主 ，这么多年了。这程序可能把兼容性提高点？大部分图都没问题，就是部分图会假死。 楼主能不能把多行文字也考虑进去呀，光是单行文字的话是完美的，但是表格里可能同时夹杂着多行文字和单行文字！ 谢谢分享，下载学习 最后一个选项，[右中]对齐，你实际工作中遇到过吗？我认为前两个选项就够了。如果非要最后一个选项，可以[左中对齐]，然后mirror一下。 自贡黄明儒 发表于 2013-12-13 08:56
最后一个选项，[右中]对齐，你实际工作中遇到过吗？我认为前两个选项就够了。如果非要最后一个选项，可以[左 ...
右中确实用不上。只不过是最后顺手加了这个功能。确实用不上的话，可以把cond里面的几行删掉，对整个程序没有影响。另外的对齐方式，也是在cond里面相应增加就可以了。
ps，非常感谢你编的通用排序函数和函数库，很好用。另外，请问下，那个通用排序涉及到多维的时候如何处理各维偏差值不一样的情况。 能改改支持天正文字么？吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101931&reltid=108685&pre_thread_id=0&pre_pos=1&ext= 程序是不错，似乎运行速度慢了些。 好東西, 謝謝分享 bai2000 发表于 2013-12-13 19:48 static/image/common/back.gif
能改改支持天正文字么？吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101931&re ...
可能行业的关系，都没见过天正的东西，所以没头绪。
不过如果知道组码的话，可以在以下几处改一下，
1.开始选取类型中加上该类型，
2. 在最后循环更改对齐组码和定位中按照对应的组码更改
3. 考虑到组码与text不同的可能性较大，还要加个判断分类的cond。 香田里浪人 发表于 2013-12-13 23:29 static/image/common/back.gif
程序是不错，似乎运行速度慢了些。
嗯，这个是硬伤。程序编完后想了想了下，一开始的y排序因为是最后加上的，但如果按后面的处理，这个并没有起什么作用。现在考虑共框判断时先用y判断下，超范围直接进行下一个框的判断。
我觉得最影响速度的还是boundary命令，不知道cad是如何运行这个命令，感觉这个命令特别的慢。你可以试一下同样一个表格，在屏幕上同样的大小，周围有图和没有图两种情况下的运行速度，差别很大啊。我觉得在对齐的时候，把要整理的表格文字尽可能的放大到屏幕中，不相干的图越少越好。 上传天正文字表格样板