被风吹走的灰尘 发表于 2024-4-1 22:19:47

感谢楼主分享源码

szhorse 发表于 2024-8-23 09:42:48

Ming131564 发表于 2023-1-18 13:55
;对象居中：by zml84 2009-06-15 此基础上修改：by 忘霄
(defun C:EC (/ box en_tmp ent i pt0 pt1 ss tmp ...

能修改一下，只让水平居中、不执行垂直居中吗？

290887497 发表于 2024-9-30 17:46:13


感谢分享,先存起来

today008 发表于 2024-10-6 21:23:44

能修改一下，只让水平居中、不执行垂直居中吗？

春江在线 发表于 2024-12-30 00:15:07

today008 发表于 2024-10-6 21:23
能修改一下，只让水平居中、不执行垂直居中吗？

针对自己需求,加上了限制单行文字
修改了只水平居中,不执行垂直居中
增加忽略不在格子内的文字

(defun C:EC (/ box en_tmp ent i pt0 pt1 ss tmp)
(setvar "CMDECHO" 0)
(vl-load-com)
(princ "\n选择需要居中的对象：")
(if (setq ss (ssget '((0 . "text"))))
    (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)
      (if (setq en_tmp (bpoly pt0));文字不在闭合格子内
                                        (progn         
                                                ;(entdel ent)
                        (setq tmp (box en_tmp))
                                                (setq tmp (mapcar '+ (car tmp) (cadr tmp)))
                        (setq pt1 (mapcar '* tmp '(0.5 0.5 0.5)))
                                                (setq pt1 (list (car pt1)(cadr pt0)(caddr pt1)))
                        (command "move" ent "" "non" pt0 "non" pt1)
                        (entdel en_tmp)                                               
                                        )
                                )

      )
      (command "undo" "e")
    )
    (princ "\n没有选择对象！")
)
(princ)
)

寒潮大冬瓜 发表于 2024-12-30 23:33:45

春江在线 发表于 2024-12-30 00:15
针对自己需求,加上了限制单行文字
修改了只水平居中,不执行垂直居中
增加忽略不在格子内的文字


很好→很棒！很好~很棒！！很好……很棒！！！收藏了！感谢！

yefei812678 发表于 2025-1-6 08:37:00

感谢楼主的无私分享 谢谢

puzb2023 发表于 2025-1-13 16:10:59

谢谢楼主分享，下载试用
页: 1 2 3 4 [5]
查看完整版本: 表格内文字居中