表格内文字居中

gaomingabc456

(vl-load-com)
(defun c:JZ(/ err)
(defun algion (msg /       ss      lst     i       vlalst  boxlst  x
               cor1    cor2    findboxpt       newboxpt               en1
               en      enlst   y       y2
              )
  (princ msg)
  (setq ss (ssget '((0 . "text"))))
  (setq lst nil)
  (setq i 0)
  (repeat (sslength ss)
    (setq lst (cons (ssname ss i) lst))
    (setq i (1+ i))
  )
  (setq vlalst (mapcar 'vlax-ename->vla-object lst))
  (setq        boxlst (mapcar '(lambda        (x / cor1 cor2)
                          (vla-GetBoundingBox x 'cor1 'cor2)
                          (list        (vlax-safearray->list cor1)
                                (vlax-safearray->list cor2)
                          )
                        )
                       vlalst
               )
  )
  (setq
    findboxpt (mapcar '(lambda (x)
                         (polar        (car x)
                                (angle (car x) (cadr x))
                                (/ (DISTANCE (car x) (cadr x)) 2.0)
                         )
                       )
                      boxlst
              )
  )
  (setq        newboxpt (mapcar '(lambda (x)
                            (setq en1 (entlast))
                            (vl-cmdf "_boundary" x "")
                            (setq en (entlast))
                            (if        (not (equal en1 en))
                              (progn
                                (setq enlst (entget en))
                                (setq lst (vl-remove-if-not
                                            '(lambda (y) (= (car y) 10))
                                            enlst
                                          )
                                )
                                (setq cor1 (vl-remove 10 (car lst))
                                      cor2 (vl-remove 10 (nth 2 lst))
                                )
                                (entdel en)
                                (polar cor1
                                       (angle cor1 cor2)
                                       (/ (DISTANCE cor1 cor2) 2.0)
                                )
                              )
                            )
                          )
                         findboxpt
                 )
  )

  (mapcar '(lambda (x y y2)
             (vla-move x (vlax-3d-point y) (vlax-3d-point y2))
           )
          vlalst
          findboxpt
          newboxpt
  )

)
(setq err(VL-CATCH-ALL-APPLY 'algion (list "\n 请选择单行文字: ")))
  (princ)
  )

Ming131564

;对象居中：by zml84 2009-06-15 此基础上修改：by 忘霄
(defun C:EC (/ box en_tmp ent i pt0 pt1 ss tmp)
  (setvar "CMDECHO" 0)
  (vl-load-com)
  (princ "\n选择需要居中的对象：")
  (if (setq ss (ssget))
    (progn
      (defun box (e / ll ur)
        (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
        (mapcar 'vlax-safearray->list (list ll ur))
      )
      (setq i -1)
      (command "undo" "be")
      (while (setq ent (ssname ss (setq i (1+ i))))
        (setq tmp (box ent))
        (setq tmp (mapcar '+ (car tmp) (cadr tmp)))
        (setq pt0 (mapcar '* tmp '(0.5 0.5 0.5)))
        (entdel ent)
        (setq en_tmp (bpoly pt0))
        (entdel ent)
        (setq tmp (box en_tmp))
        (setq tmp (mapcar '+ (car tmp) (cadr tmp)))
        (setq pt1 (mapcar '* tmp '(0.5 0.5 0.5)))
        (command "move" ent "" "non" pt0 "non" pt1)
        (entdel en_tmp)
      )
      (command "undo" "e")
    )
    (princ "\n没有选择对象！")
  )
  (princ)
)
这个还支持实体和多行文字

纵横八方

挺不错的哦

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

逍遥天下

感谢楼主分享源码

fsafaffa

只支持单行文字，能增加支持所有文字，所有物体吗

天下逍遥

支持，顶顶顶

sowin

回帖是一种美德！感谢楼主的无私分享

被雨淋湿的鱼℡

不错，感谢分享

myhobby76

thanks.........................

/fendou结构绘图

感谢分享,先存起来