再次求助高手们完善下面这个封闭区域内文本居中小程序

hnlgy

原程序来自论坛里的 “绝情一剑” ，短小精悍，比较实用。根据我的需求小小地改动了一下选择对象的方式。原程序只允许选择单行文本，现在改为可以选中单行、多行文本了。实际运行过程中多行文本居中有问题。 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)
     )
    )
  )
)

Qwer1243

gzxl 发表于 2013-6-15 00:03
是不是这样的？先发个测试的fas，如是这样再奉上代码

大佬 能发一下这个文本居中的源码 学习一下吗

注册

多行文字居中后字基本重合，何解

hnlgy

您那不是多行文本，而是多个单行文本对象。
单行文本是由text对象，多行文本是mtext对象。

gzxl

试试这个

2. ;;;===选择集实体外矩形框(左下角点与右上角点)
   
3. ;;;示例 (GetssBox (ssget))
   
4. (defun GetssBox (ss / i L l1 l2 ll ur)
   
5.   (setq L (sslength ss))
   
6.   (repeat (setq i L)
   
7.     (vla-getBounDingBox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
   
8.     (setq l1 (cons (vlax-safearray->list ll) l1)
   
9.           l2 (cons (vlax-safearray->list ur) l2)
   
10.     )
    
11.   )
    
12.   (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
    
13. )

;;;===选择集实体外矩形框(左下角点与右上角点)<br /> ;;;示例 (GetssBox (ssget))<br /> (defun GetssBox (ss / i L l1 l2 ll ur)<br />   (setq L (sslength ss))<br />   (repeat (setq i L)<br />     (vla-getBounDingBox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)<br />     (setq l1 (cons (vlax-safearray->list ll) l1)<br />           l2 (cons (vlax-safearray->list ur) l2)<br />     )<br />   )<br />   (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))<br /> )

gzxl

hnlgy 发表于 2013-6-12 10:02
您那不是多行文本，而是多个单行文本对象。
单行文本是由text对象，多行文本是mtext对象。

改了下好像一样的，楼主最好发张测试图

wau2000022

可以联系我QQ496968041

gzxl

wau2000022 发表于 2013-6-12 11:02
可以联系我QQ496968041

啥意思，QQ号码广告

669423907

其实楼主不必局限于文字，
我这里收藏了一个，很通用的：
非常感谢原作者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)))

hnlgy

669423907 发表于 2013-6-13 11:18
其实楼主不必局限于文字，
我这里收藏了一个，很通用的：
非常感谢原作者zml84大师

谢谢您的回复，不过还是不符合我的需求。1、未能解决多行文本的问题。2、只能一个个的选择，不能一次框选。

hnlgy

顶起来让大家看见，别沉了。