将TEXT,MTEXT对齐方式修改为窗口的正中

Lisphk · 发表于 2017-7-31 10:14:16

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:tt (/ e ll ur c n)
(if
(and
(progn
(while
(and
(setq e (car (entsel "\nSelect Text or MText: ")))
(not (wcmatch (cdr (assoc 0 (setq l (entget e)))) "*TEXT"))
)
(princ "\n** Object must be Text or MText **")
)
e
)
(setq ll (getpoint "\nPick Lower-Left Corner: "))
(setq ur (getpoint "\nPick Upper-Right Corner: " ll))
(setq c (polar ll (angle ll ur) (/ (distance ll ur) 2.)))
(setq n (trans '(0. 0. 1.) 1 0 t))
)
(entupd
(cdr
(assoc -1
(entmod (if (eq "MTEXT" (cdr (assoc 0 l)))
(SubstDXF 10 (trans c 1 0) (SubstDXF 71 5 l))
(SubstDXF 11
(trans c 1 n)
(SubstDXF 72 1 (SubstDXF 73 2 l))
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ e ll ur c n) 
  (if 
    (and 
      (progn 
        (while 
          (and 
            (setq e (car (entsel "\nSelect Text or MText: "))) 
            (not (wcmatch (cdr (assoc 0 (setq l (entget e)))) "*TEXT")) 
          ) 
           (princ "\n** Object must be Text or MText **") 
        ) 
        e 
      ) 
      (setq ll (getpoint "\nPick Lower-Left Corner: ")) 
      (setq ur (getpoint "\nPick Upper-Right Corner: " ll)) 
      (setq c (polar ll (angle ll ur) (/ (distance ll ur) 2.))) 
      (setq n (trans '(0. 0. 1.) 1 0 t)) 
    ) 
     (entupd 
       (cdr 
         (assoc        -1 
                (entmod        (if (eq "MTEXT" (cdr (assoc 0 l))) 
                          (SubstDXF 10 (trans c 1 0) (SubstDXF 71 5 l)) 
                          (SubstDXF 11 
                                    (trans c 1 n) 
                                    (SubstDXF 72 1 (SubstDXF 73 2 l)) 
                          ) 
                        ) 
                ) 
         ) 
       ) 
     ) 
  ) 
  (princ) 
)

SubstDXF :

游客，如果您要查看本帖隐藏内容请回复

Lisphk · 发表于 2017-7-31 10:17:09

本帖最后由 Lisphk 于 2017-7-31 10:19 编辑

另外一个同功能的,用VLISP实现的。

(defun c:InRec (/ obj ptA ptB ptBase ptBL ptTR)
(vl-load-com)
(if (and (setq obj (car (entsel "\nSelect (text) object to move: ")))
(setq obj (vlax-ename->vla-object obj))
(setq ptA (getpoint "\nFirst corner of rectangle: "))
(setq ptB (getpoint ptA "\nSecond corner of rectangle: "))
)
(progn (cond ((vlax-property-available-p obj 'attachmentpoint)
; AcDbMText
(vlax-put obj 'attachmentpoint 5) ; 5 = middle center
(setq ptBase (vlax-get obj 'insertionpoint))
)
((vlax-property-available-p obj 'alignment) ; AcDbText
(vlax-put obj 'alignment 10)
; 10 = middle center; 4 = middle
(setq ptBase (vlax-get obj 'textalignmentpoint))
)
('T
(vla-getboundingbox obj 'ptBL 'ptTR)
(setq ptBase (kg:MidPoint
(vlax-safearray->list ptBL)
(vlax-safearray->list ptTR)
)
)
)
)
(vlax-invoke
obj
'move
ptBase
(trans (kg:MidPoint ptA ptB) 1 0)
)
)
)
)
(defun kg:MidPoint (pt1 pt2)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)
)
(princ "\nUsage: InRec ")
(princ)

(defun c:InRec (/ obj ptA ptB ptBase ptBL ptTR) 
  (vl-load-com) 
  (if (and (setq obj (car (entsel "\nSelect (text) object to move: "))) 
           (setq obj (vlax-ename->vla-object obj)) 
           (setq ptA (getpoint "\nFirst corner of rectangle: ")) 
           (setq ptB (getpoint ptA "\nSecond corner of rectangle: ")) 
      ) 
    (progn (cond ((vlax-property-available-p obj 'attachmentpoint) 
                                        ; AcDbMText 
                  (vlax-put obj 'attachmentpoint 5) ; 5 = middle center 
                  (setq ptBase (vlax-get obj 'insertionpoint)) 
                 ) 
                 ((vlax-property-available-p obj 'alignment) ; AcDbText 
                  (vlax-put obj 'alignment 10) 
                                        ; 10 = middle center; 4 = middle 
                  (setq ptBase (vlax-get obj 'textalignmentpoint)) 
                 ) 
                 ('T 
                  (vla-getboundingbox obj 'ptBL 'ptTR) 
                  (setq        ptBase (kg:MidPoint 
                                 (vlax-safearray->list ptBL) 
                                 (vlax-safearray->list ptTR) 
                               ) 
                  ) 
                 ) 
           ) 
           (vlax-invoke 
             obj 
             'move 
             ptBase 
             (trans (kg:MidPoint ptA ptB) 1 0) 
           ) 
    ) 
  ) 
) 
 
(defun kg:MidPoint (pt1 pt2) 
  (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2) 
) 
 
(princ "\nUsage: InRec ") 
(princ)

q3_2006 · 发表于 2017-7-31 10:28:55

多行文本用得少..改成居中什么样??

cq025 · 发表于 2017-7-31 10:46:46

kkkkkkkkkkkkkkkkkkkkkkkkkkkkk

yoyoho · 发表于 2017-7-31 11:22:21

谢谢分享学习！！！！！

sh_h · 发表于 2017-7-31 11:30:07

谢谢楼主分享！！！

bbswen · 发表于 2017-7-31 12:55:01

位置改变不？

HLCAD · 发表于 2017-7-31 14:03:18

感谢楼主的源代码！

1993063 · 发表于 2017-8-1 08:08:12

感谢楼主的源代码！

sicky111 · 发表于 2017-8-1 10:23:27

回复学习。

819534890 · 发表于 2017-8-1 22:36:37

回复学习，谢谢

winabcd · 发表于 2017-8-2 11:29:50

回复学习。

kqqt6236 · 发表于 2017-8-4 00:11:05

看看隐藏的是什么。

naruto018 · 发表于 2018-12-14 16:04:23

来学习一下

qyming2000 · 发表于 2018-12-18 20:22:39

看看藏了什么
来自: 微社区

账号		自动登录	找回密码
密码			立即注册

[每日一码] 将TEXT,MTEXT对齐方式修改为窗口的正中

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分