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

lostbalance · 发表于 2013-12-12 23:50:26

本帖最后由 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]/右中[f]: <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)~~
)

;;表格多行文字对齐[左中/中间/右中]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左中<strike>/中间[d]/右中[f]: <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) 
)

lifuor · 发表于 2018-1-13 21:51:28

感谢题主分享，工具挺好用的。看图片圆圈里，d，s都有，但是缺了f。还有想请教下，圆圈里的那个菜单是怎么实现的？
建议：实际使用中，如果表格框比较大，字比较小，使用后会导致两个字之间行间距过大。可否增加控制行间距为字高的几分之一？

AndyWang · 发表于 2022-1-4 15:17:28

lostbalance 发表于 2014-8-26 22:53
影响运行的主要就是判断文字框的boundary命令。lisp中调用cad的command命效率都很低，除非找到其他的 ...

楼主，这么多年了。这程序可能把兼容性提高点？大部分图都没问题，就是部分图会假死。

kexiya123 · 发表于 2017-12-15 10:10:44

楼主能不能把多行文字也考虑进去呀，光是单行文字的话是完美的，但是表格里可能同时夹杂着多行文字和单行文字！

01011001 · 发表于 2013-12-13 00:32:48

谢谢分享，下载学习

自贡黄明儒 · 发表于 2013-12-13 08:56:42

最后一个选项，[右中]对齐，你实际工作中遇到过吗？我认为前两个选项就够了。如果非要最后一个选项，可以[左中对齐]，然后mirror一下。

lostbalance · 发表于 2013-12-13 11:07:43

自贡黄明儒发表于 2013-12-13 08:56
最后一个选项，[右中]对齐，你实际工作中遇到过吗？我认为前两个选项就够了。如果非要最后一个选项，可以[左 ...

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

bai2000 · 发表于 2013-12-13 19:48:33

能改改支持天正文字么？吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mo ... ;pre_pos=1&ext=

香田里浪人 · 发表于 2013-12-13 23:29:44

程序是不错，似乎运行速度慢了些。

alan0019hk · 发表于 2013-12-14 02:16:29

好東西, 謝謝分享

lostbalance · 发表于 2013-12-14 09:57:19

bai2000 发表于 2013-12-13 19:48
能改改支持天正文字么？吧老大的函数加进去
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101931&re ...

可能行业的关系，都没见过天正的东西，所以没头绪。
不过如果知道组码的话，可以在以下几处改一下，
1. 开始选取类型中加上该类型，
2. 在最后循环更改对齐组码和定位中按照对应的组码更改
3. 考虑到组码与text不同的可能性较大，还要加个判断分类的cond。

lostbalance · 发表于 2013-12-14 10:17:08

香田里浪人发表于 2013-12-13 23:29
程序是不错，似乎运行速度慢了些。

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

bai2000 · 发表于 2013-12-14 12:17:42

上传天正文字表格样板

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

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

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

本帖子中包含更多资源

点评

本帖子中包含更多资源