LISP程序实现：批量文本对齐于框格（待改进）
本帖最后由 yrgui 于 2010-12-28 10:19 编辑LISP程序实现：批量文本对齐于框格具体要求：1、获得选择集中的文本对象（单行、多行、属性文字）。2、依次对选择集中的文本对象进行如下处理 a)获得文本中心点tcp以及tcp所在框格的中心点bcp、左边中点blp。（用两次getboundingbox即可） b)更改文本对齐属性（一定要更改）并移动文本。
i.文本若以空格开头，改文本的对齐属性为左中对齐，并将文本以其左中对齐点tlp为基移动到blp。
ii.否则，更改文本的对齐属性为中间对齐，并将文本以tcp为基移动到bcp。昨天得到zml84和redcat写的代码感觉很好。
Zml84见二楼：功能如其介绍“点取对象，使其居中”，简单强大。
redcat见三楼：原理上差不多，但redcat这个更像一个实用程序，对选择集的处理设计的很好。实现了批量文本居中于框格，但也有一些问题：居中于框格的文本如果再编辑，它就不居中中了，得重新运用该命令操作一遍，解决办法是先将文本对象的对齐方式改为居中对齐；在框格中的文本对齐还有一种需求是左中边对齐，这功能也没实现，考虑到左中边对齐和居中对齐的同时批量处理和左中边对齐时的可读性，对左中边对齐文本加前导空格处理（加空格不需要在代码里实现）。
(setvar "CMDECHO" 0)
(vl-load-com)
;;;=================================================================*
;;;功能：点取对象，使其居中 *
;;;日期：zml84 于 2009-06-15 *
(defun C:JZ (/ X Y SIZE PT EN AREA STR TMP)
;; 0 初始化
(if (and (setq SS (entsel "\n点取需要居中的对象: "))
(setq EN (car SS))
(setq EN_TMP (bpoly (cadr SS)))
)
(progn
;;
(setq TMP (BOX EN)
TMP (mapcar '+ (car TMP) (cadr TMP))
PT0 (mapcar '* TMP '(0.5 0.5 0.5))
)
;;
(setq TMP (BOX EN_TMP)
TMP (mapcar '+ (car TMP) (cadr TMP))
PT1 (mapcar '* TMP '(0.5 0.5 0.5))
)
;;
(command "_.move" EN "" "non" PT0 "non" PT1)
(entdel EN_TMP)
)
)
(princ)
)
;;;=================================================================*
;;;=================================================================*
;;; 下面函数取自：http://www.mjtd.com/blog/user1/45/archives/2005/48.asp
;;; 功能：求单个实体box. ok! *
;;; (box e) *
(defun BOX (E / LL UR)
(vla-getboundingbox (vlax-ename->vla-object E) 'LL 'UR)
;;生成box 变体数据.
(mapcar 'vlax-safearray->list (list LL UR))
;;box转表.
)
(defun sset->list (sset xflag / ssetlist)
(setq ssetlist
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex sset))
) ;_ 结束vl-remove-if
) ;_ 结束setq
(if xflag
(mapcar 'vlax-ename->vla-object ssetlist)
ssetlist
) ;_ 结束if
) ;_ 结束defun
;;;功能:获取实体中心
;;;参数:1.ent_obj→图元名或者vla对象
;;;返回值:以表的形式返回实体中心
;;;示例： (setq ent_obj(car(entsel)))(getcenter ent_obj)
(defun getcenter (ent_obj / L_dwn R_up)
(if (= (type ent_obj) 'ename)
(setq ent_obj (vlax-ename->vla-object ent_obj))
) ;_ 结束if
(vla-getboundingbox ent_obj 'L_dwn 'R_up)
(setq L_dwn (vlax-safearray->list L_dwn)
R_up(vlax-safearray->list R_up)
) ;_ 结束setq
(mapcar '(lambda (a b) (/ (+ a b) 2)) L_dwn R_up)
) ;_ 结束defun
(defun c:Q1()
(defun algion (/ acad_obj doc pt ss vlalst x boxcenterpt newboxpt oldent newent)
(princ "\n 选择将要居中的文字: ")
(setq acad_obj (vlax-get-acad-object)
doc (vla-get-activedocument acad_obj)
) ;_ 结束setq
(setq ss (ssget '((0 . "*text,ATTDEF")))
vlalst (sset->list ss t)
boxcenterpt (mapcar 'getcenter vlalst)
newboxpt (mapcar '(lambda (x)
(setq oldent (entlast))
(vl-cmdf "boundary" "a" "o" "p" "" x "")
(setq newent (entlast))
(if (not (equal oldent newent))
(progn
(setq pt (getcenter newent))
(entdel newent)
pt
) ;_ 结束progn
) ;_ 结束if
) ;_ 结束lambda
boxcenterpt
) ;_ 结束mapcar
) ;_ 结束setq
(mapcar '(lambda (x y1 y2)
(if (equal y1 y2)
()
(vla-move x (vlax-3d-point y1) (vlax-3d-point y2))
) ;_ 结束if
) ;_ 结束lambda
vlalst
boxcenterpt
newboxpt
) ;_ 结束mapcar
) ;_ 结束defun
(vl-catch-all-apply 'algion)
(princ)
) ;_ 结束defun 本帖最后由 Gu_xl 于 2010-12-28 10:43 编辑
计算多文本的中心就不能用vla-getboundingbox 来计算了，vla-getboundingbox 计算的只是文本框的包围盒，并不是实际文字的包围盒，一般可根据多文本的组码来计算文字大小，组吗42 代表 构成多行文字图元的字符的水平宽度，组码43代表多行文字图元的垂直高度，然后根据文字的对齐点组码71的值，来计算多文本文字的实际包围盒！
回复 Gu_xl 的帖子
包围盒就可以了，要求不高，谢谢斑竹 回复 Gu_xl 的帖子
把它的宽度置为0后getboundingbox就能得到了 还是无法实现2行或多行文字的居中
页:
[1]