怎样才能求出一行文字的中心点坐标？

wdb

怎样才能求出一行文字的中心点坐标？



要求：能求MTEXT或TEXT写的文字，任何字体，任意角度，左对齐，右对齐或中间对齐文字。


该出手时就出手，有鲜花相送！！！！！！！！！！

nono

(defun c:check_center ()
(setq en (car (entsel "\n选取文字")))
(setq en_data (entget en))
(command "ucs" "e" en)
(setq box (textbox en_data))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq cen (inters p1 p3 p2 p4))
(command "circle" cen 10)
(command "ucs" "")
)

ZZXXQQ

下面的程序在文字中心画一个点。

1. (DEFUN TEXTCEN ()
2.   (SETQ OBJ (ENTSEL "\nSelect Text : "))
3.   (IF (/= OBJ nil) (PROGN
4.    (SETQ ENT (ENTGET (CAR OBJ)))
5.    (IF (= (CDR (ASSOC 0 ENT)) "TEXT") (PROGN
6.      (SETQ TEMP       (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
7.                  PT_BASE (CDR (ASSOC 10 ENT))
8.                  ANG         (CDR (ASSOC 50 ENT))
9.                  TEXTW     (CDR (ASSOC 41 ENT))
10.                  TEMP_W   (* (CAR TEMP) TEXTW)
11.                  TEMP_H   (CADR TEMP)
12.                  PT_CEN (POLAR (POLAR PT_BASE ANG (* TEMP_W 0.5)) (+ (/ PI 2) ANG) (* TEMP_H 0.5)))
13.      (COMMAND "POINT" PT_CEN)
14.    ))
15.   ))
16. )

复制代码

meflying

;;By 龙龙仔(LUCAS)
;;在TEXT和MTEXT实体的几何中心点画点
;;参数:sname - 文字对象名 (vl-load-com)
(defun TT (sname / CENTPT N)
(defun AX:GETBOUNDINGBOX (ENT / LL UR)
(vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
(MIDPOINT (vlax-safearray->list LL)
(vlax-safearray->list UR)
)
)
(defun MIDPOINT (PT1 PT2)
(mapcar
'(lambda (X Y)
(* 0.5 (+ X Y))
)
PT1
PT2
)
)
(setq CENTPT (AX:GETBOUNDINGBOX sname))
(command "_.point" centpt)
(princ)
)

wdb

ok,太感谢了。

wdb

当选择MTEXT写的文字时，2楼的程序出错。3楼的干脆就不求中点，4楼的能求出中点，但不是真正的文字的中点，而是文本框的中点。如何修改啊？

meflying

;;By 龙龙仔(LUCAS)，Modified by meflying
;;在TEXT和MTEXT实体的几何中心点画点
;;参数:sname - 文字对象名 (vl-load-com)
(defun TT (sname / CENTPT N)
(defun AX:GETBOUNDINGBOX (ENT / LL UR ents ents2)
(setq ents (entget ent))
(if (= (cdr (assoc 0 ents)) "MTEXT")
(progn
(setq ents2 ents)
(setq ents2 (subst (cons 41 0) (assoc 41 ents2) ents2))
(entmod ents2)
)
)
(vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
(entmod ents)
(MIDPOINT (vlax-safearray->list LL)
(vlax-safearray->list UR)
)
)
(defun MIDPOINT (PT1 PT2)
(mapcar
'(lambda (X Y)
(* 0.5 (+ X Y))
)
PT1 PT2
)
)
(setq CENTPT (AX:GETBOUNDINGBOX sname))
(command "_.point" centpt)
(princ)
)

wdb

成功了，谢谢meflying。