社区 › 源码共享 › 表格内文字居中

gaomingabc456 发表于 2017-8-4 10:47:56

表格内文字居中

(vl-load-com)
(defun c:JZ(/ err)
(defun algion (msg /       ss      lst   i       vlalstboxlstx
             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 发表于 2023-1-18 13:55:15

;对象居中：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)
)
这个还支持实体和多行文字

纵横八方 发表于 2018-8-28 12:31:45

挺不错的哦

pengfei2010 发表于 2017-10-9 16:18:15

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

逍遥天下 发表于 2017-10-14 13:26:06

感谢楼主分享源码

fsafaffa 发表于 2017-10-14 13:43:01

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

天下逍遥 发表于 2017-10-14 13:51:51

支持，顶顶顶

sowin 发表于 2017-11-2 16:13:29

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

被雨淋湿的鱼℡ 发表于 2018-5-8 10:49:50

不错，感谢分享

myhobby76 发表于 2018-8-18 22:25:53

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

/fendou结构绘图 发表于 2018-8-28 11:31:50

感谢分享,先存起来

查看完整版本: 表格内文字居中