再次求助高手们完善下面这个封闭区域内文本居中小程序
本帖最后由 hnlgy 于 2013-6-12 08:53 编辑原程序来自论坛里的 “绝情一剑” ，短小精悍，比较实用。根据我的需求小小地改动了一下选择对象的方式。原程序只允许选择单行文本，现在改为可以选中单行、多行文本了。实际运行过程中多行文本居中有问题。 vla-getboundingbox函数在取得多行文本包围框坐标的时候，是按照多行文本的宽度、高度值来取值的，而不是按实际文本的宽度与高度。解决的办法是将多行文本的宽度、高度值设置为0，就可以获得满意的效果。 请高手们修改一下下面的代码，将多行文本的宽度、高度属性设置为0。
;;;==================================================================================
;;; 文字居中程序，SNSJ。原程序来自 明经论坛 绝情一剑
;;; 原帖地址：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=67812&page=3#pid358978
;;; 命令 WZCS
;;;==================================================================================
(defun c:WZCS (/ mid obj mid1 dob selobjs)
(setvar "cmdecho" 0)
(Princ "\n 将所选文字在封闭区域内对齐... \n")
(setq selobjs (ssget '((0 . "TEXT,MTEXT"))))
(vl-cmdf "undo" "BE")
(if selobjs
(progn
(vlax-for obj (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(if (/= (setq ob (bpoly (setq mid (pt1-pt2-mid obj)))) nil)
(progn
(setq mid1
(pt1-pt2-mid (setq dob (vlax-ename->vla-object ob)))
)
(vla-delete dob)
(vla-move obj (vlax-3D-point mid) (vlax-3D-point mid1))
)
)
)
)
(princ "\n...您未选中文本对象...")
)
(vl-cmdf "undo" "E")
(princ)
)
;;;|求物体中心
(defun pt1-pt2-mid (e / minpoint maxpoint)
(vla-getboundingbox e 'minpoint 'maxpoint)
(setq pt (mapcar '*
'(0.5 0.5)
(mapcar '+
(vlax-safearray->list minpoint)
(vlax-safearray->list maxpoint)
)
)
)
)
gzxl 发表于 2013-6-15 00:03
是不是这样的？先发个测试的fas，如是这样再奉上代码
大佬 能发一下这个文本居中的源码 学习一下吗 多行文字居中后字基本重合，何解 您那不是多行文本，而是多个单行文本对象。
单行文本是由text对象，多行文本是mtext对象。 试试这个;;;===选择集实体外矩形框(左下角点与右上角点)
;;;示例 (GetssBox (ssget))
(defun GetssBox (ss / i L l1 l2 ll ur)
(setq L (sslength ss))
(repeat (setq i L)
(vla-getBounDingBox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
) hnlgy 发表于 2013-6-12 10:02 static/image/common/back.gif
您那不是多行文本，而是多个单行文本对象。
单行文本是由text对象，多行文本是mtext对象。
改了下好像一样的，楼主最好发张测试图 可以联系我QQ496968041 wau2000022 发表于 2013-6-12 11:02 static/image/common/back.gif
可以联系我QQ496968041
啥意思，QQ号码广告 其实楼主不必局限于文字，
我这里收藏了一个，很通用的：
非常感谢原作者zml84大师
;对象居中（zml84，2009-06-15）
(defun c:xa(/ X Y SIZE PT EN AREA STR TMP)
(while(setq SS (entsel "\n点取需要居中的对象:"))
(setq EN (car SS))
(command "undo" "be")
(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))
(defun BOX (E / LL UR)
(vla-getboundingbox (vlax-ename->vla-object E) 'LL 'UR)
(mapcar 'vlax-safearray->list (list LL UR))) 669423907 发表于 2013-6-13 11:18 static/image/common/back.gif
其实楼主不必局限于文字，
我这里收藏了一个，很通用的：
非常感谢原作者zml84大师
谢谢您的回复，不过还是不符合我的需求。1、未能解决多行文本的问题。2、只能一个个的选择，不能一次框选。 顶起来让大家看见，别沉了。
页:
[1]
2