[求助]TextBox函数有时不灵了

carrot1983 · 发表于 2009-12-18 13:05:00

本帖最后由作者于 2009-12-18 14:32:21 编辑

测试图:

具体情况详动画：

相关的代码如下：

;;文本包围框
(defun C-TEXTBOX (ENT / I ENAME ELIST LST LST2 TB TB1
TB2 TLEN THI LL LR UR UL ANG ANGG
UCSANG LLX LRX URX ULX LLY LRY URY
ULY ALL AVG ERR CNTLST
)
(setq UCSANG (angle (trans '(0.0 0.0 0.0) 1 0)
(trans '(1.0 0.0 0.0) 1 0)
)
)
(setq ELIST (entget ENT)
ANG (cdr (assoc 50 ELIST))
TB (textbox ELIST)
TB1 (car TB)
TB2 (cadr TB)
TLEN (- (car TB2) (car TB1))
THI (- (cadr TB2) (cadr TB1))
LL (mapcar '+ (trans (cdr (assoc 10 ELIST)) 0 1) TB1)
ANG (- ANG UCSANG)
LR (polar LL ANG TLEN)
UR (polar LL (+ ANG (angle TB1 TB2)) (distance TB1 TB2))
UL (polar LL (+ ANG (/ pi 2)) THI)
)
(list LL LR UR UL)
)
(defun c:tt ()
(setq ent (car (entsel)))
(setq ptList (C-TEXTBOX ent))
(command "_.PLINE")
(foreach X ptList
(command "_NON" X)
)
(command "_C")
)

附上字体文件：

可能跟字体有关系

tender138 · 发表于 2024-8-1 09:11:35

xianaihua 发表于 2009-12-18 18:10
看看一个老外写得文本框工具，可以对单行、多行、尺寸文本加框，而且对于任意角度都可以。

多谢分享！顶你！

muai2010 · 发表于 2024-8-1 16:43:34

文字框函数问题把，我的能正常用

liminnet · 发表于 2009-12-18 13:17:00

提示: 作者被禁止或删除内容自动屏蔽

carrot1983 · 发表于 2009-12-18 14:33:00

将字体附上。

可能跟字体有关系。

caoyin · 发表于 2009-12-18 16:44:00

是你的算法问题，我用我自己的程序正常

carrot1983 · 发表于 2009-12-18 17:04:00

应该是textbox函数没有写正确。

xianaihua · 发表于 2009-12-18 18:10:00

看看一个老外写得文本框工具，可以对单行、多行、尺寸文本加框，而且对于任意角度都可以。

;-------------------------------------------------------------------------------
; Program Name: Text-Box.lsp [Text-Box R2]
; Created By: Terry Miller (Email: terrycadd@yahoo.com)
; c:Text-Box - Draws a polyline Text Box outlining Text, Mtext and Dimensions.
;-------------------------------------------------------------------------------
(defun c:TB ( )(c:Text-Box));Shortcut
(defun c:Text-Box (/ Cnt# EntName^ Osmode# Pt PtsList@ SS&)
(setq Osmode# (getvar "OSMODE"))
(princ "\nSelect Text, Mtext or Dimension for Text Box")
(if (setq SS& (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(0 . "DIMENSION")(-4 . "OR>"))))
(progn
(command "UNDO" "BEGIN")
(setvar "OSMODE" 0)
(setq Cnt# 0)
(repeat (sslength SS&)
(setq EntName^ (ssname SS& Cnt#))
(setq PtsList@ (append (Text-Box EntName^) (list "C")))
(command "PLINE" (foreach Pt PtsList@ (command Pt)))
(setq Cnt# (1+ Cnt#))
);repeat
(command "UNDO" "END")
(setvar "OSMODE" Osmode#)
);progn
(princ "\nNo Text, Mtext or Dimension selected.")
);if
(princ)
);defun c:Text-Box
;-------------------------------------------------------------------------------
; Text-Box - Function for Text, Mtext and Dimension entities
; Arguments: 1
; Entity^ = Entity name of the Text, Mtext or Dimension to use
; Returns: A list of the four corners of the Text Box
;-------------------------------------------------------------------------------
(defun Text-Box (Entity^ / Ang~ AngEntity~ Corners: EntList@ EntNext^ EntType$
First List@ MovePt NewPts@ Pt Return@ Textboxes@ X X1 X3 Y Y1 Y3 Zero)
;-----------------------------------------------------------------------------
; Corners: - Calculates the four corners of the Text Box
;-----------------------------------------------------------------------------
(defun Corners: (Entity^ / Ang~ Corners@ Dist~ EntList@ Ins Pt Pt1 Pt2 Pt3 Pt4)
(setq EntList@ (entget Entity^)
Corners@ (textbox EntList@)
Ang~ (cdr (assoc 50 EntList@))
Ins (cdr (assoc 10 EntList@))
Pt (mapcar '+ (car Corners@) Ins)
Pt1 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
Pt (mapcar '+ (cadr Corners@) Ins)
Pt3 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
Dist~ (* (distance (car Corners@) (cadr Corners@)) (cos (- (angle Pt1 Pt3) Ang~)))
Pt2 (polar Pt1 Ang~ Dist~)
Pt4 (polar Pt3 Ang~ (- Dist~))
);setq
(list Pt1 Pt2 Pt3 Pt4)
);defun Corners:
;-----------------------------------------------------------------------------
(setq EntList@ (entget Entity^)
EntType$ (cdr (assoc 0 EntList@))
);setq
(cond
((= EntType$ "TEXT")
(setq Return@ (Corners: Entity^))
);case
((or (= EntType$ "MTEXT")(= EntType$ "DIMENSION"))
(command "UNDO" "MARK")
(setq EntNext^ (entlast))
(command "EXPLODE" Entity^)
(if (= EntType$ "DIMENSION")
(command "EXPLODE" (entlast))
);if
(while (setq EntNext^ (entnext EntNext^))
(if (= "TEXT" (cdr (assoc 0 (entget EntNext^))))
(setq Textboxes@ (append Textboxes@ (list (Text-Box EntNext^))))
);if
);while
(command "UNDO" "BACK")
(setq AngEntity~ (angle (nth 0 (nth 0 Textboxes@))(nth 1 (nth 0 Textboxes@)))
Zero (list 0 0)
First t
);setq
(foreach List@ Textboxes@
(foreach Pt List@
(setq X (car Pt) Y (cadr Pt))
(if First
(setq First nil X1 X Y1 Y)
);if
(if (< X X1)(setq X1 X))
(if (< Y Y1)(setq Y1 Y))
);foreach
);foreach
(if (or (< X1 0)(< Y1 0))
(progn
(cond
((and (< X1 0)(< Y1 0))(setq MovePt (list X1 Y1)))
((< X1 0)(setq MovePt (list X1 0)))
((< Y1 0)(setq MovePt (list 0 Y1)))
);cond
(command "UCS" "M" MovePt)
);progn
);if
(setq First t)
(foreach List@ Textboxes@
(foreach Pt List@
(setq Ang~ (- (angle Zero Pt) AngEntity~))
(setq Pt (polar Zero Ang~ (distance Zero Pt)))
(setq X (car Pt) Y (cadr Pt))
(if First
(setq First nil X1 X X3 X Y1 Y Y3 Y)
);if
(if (< X X1)(setq X1 X))
(if (< Y Y1)(setq Y1 Y))
(if (> X X3)(setq X3 X))
(if (> Y Y3)(setq Y3 Y))
);foreach
);foreach
(command "UCS" "W")
(setq NewPts@ (list (list X1 Y1)(list X3 Y1)(list X3 Y3)(list X1 Y3)))
(foreach Pt NewPts@
(setq Ang~ (+ (angle Zero Pt) AngEntity~))
(setq Pt (polar Zero Ang~ (distance Zero Pt)))
(setq Return@ (append Return@ (list Pt)))
);foreach
);case
);cond
Return@
);defun Text-Box
;-------------------------------------------------------------------------------
(princ)

;-------------------------------------------------------------------------------
; Program Name: Text-Box.lsp [Text-Box R2]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
; c:Text-Box -  Draws a polyline Text Box outlining Text, Mtext and Dimensions.
;-------------------------------------------------------------------------------
(defun c:TB ( )(c:Text-Box));Shortcut
(defun c:Text-Box (/ Cnt# EntName^ Osmode# Pt PtsList@ SS&)
  (setq Osmode# (getvar "OSMODE"))
  (princ "\nSelect Text, Mtext or Dimension for Text Box")
  (if (setq SS& (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(0 . "DIMENSION")(-4 . "OR>"))))
    (progn
      (command "UNDO" "BEGIN")
      (setvar "OSMODE" 0)
      (setq Cnt# 0)
      (repeat (sslength SS&)
        (setq EntName^ (ssname SS& Cnt#))
        (setq PtsList@ (append (Text-Box EntName^) (list "C")))
        (command "PLINE" (foreach Pt PtsList@ (command Pt)))
        (setq Cnt# (1+ Cnt#))
      );repeat
      (command "UNDO" "END")
      (setvar "OSMODE" Osmode#)
    );progn
    (princ "\nNo Text, Mtext or Dimension selected.")
  );if
  (princ)
);defun c:Text-Box
;-------------------------------------------------------------------------------
; Text-Box - Function for Text, Mtext and Dimension entities
; Arguments: 1
;   Entity^ = Entity name of the Text, Mtext or Dimension to use
; Returns: A list of the four corners of the Text Box
;-------------------------------------------------------------------------------
(defun Text-Box (Entity^ / Ang~ AngEntity~ Corners: EntList@ EntNext^ EntType$
  First List@ MovePt NewPts@ Pt Return@ Textboxes@ X X1 X3 Y Y1 Y3 Zero)
  ;-----------------------------------------------------------------------------
  ; Corners: - Calculates the four corners of the Text Box
  ;-----------------------------------------------------------------------------
  (defun Corners: (Entity^ / Ang~ Corners@ Dist~ EntList@ Ins Pt Pt1 Pt2 Pt3 Pt4)
    (setq EntList@ (entget Entity^)
          Corners@ (textbox EntList@)
          Ang~ (cdr (assoc 50 EntList@))
          Ins (cdr (assoc 10 EntList@))
          Pt (mapcar '+ (car Corners@) Ins)
          Pt1 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
          Pt (mapcar '+ (cadr Corners@) Ins)
          Pt3 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
          Dist~ (* (distance (car Corners@) (cadr Corners@)) (cos (- (angle Pt1 Pt3) Ang~)))
          Pt2 (polar Pt1 Ang~ Dist~)
          Pt4 (polar Pt3 Ang~ (- Dist~))
    );setq
    (list Pt1 Pt2 Pt3 Pt4)
  );defun Corners:
  ;-----------------------------------------------------------------------------
  (setq EntList@ (entget Entity^)
        EntType$ (cdr (assoc 0 EntList@))
  );setq
  (cond
    ((= EntType$ "TEXT")
      (setq Return@ (Corners: Entity^))
    );case
    ((or (= EntType$ "MTEXT")(= EntType$ "DIMENSION"))
      (command "UNDO" "MARK")
      (setq EntNext^ (entlast))
      (command "EXPLODE" Entity^)
      (if (= EntType$ "DIMENSION")
        (command "EXPLODE" (entlast))
      );if
      (while (setq EntNext^ (entnext EntNext^))
        (if (= "TEXT" (cdr (assoc 0 (entget EntNext^))))
          (setq Textboxes@ (append Textboxes@ (list (Text-Box EntNext^))))
        );if
      );while
      (command "UNDO" "BACK")
      (setq AngEntity~ (angle (nth 0 (nth 0 Textboxes@))(nth 1 (nth 0 Textboxes@)))
            Zero (list 0 0)
            First t
      );setq
      (foreach List@ Textboxes@
        (foreach Pt List@
          (setq X (car Pt) Y (cadr Pt))
          (if First
            (setq First nil X1 X Y1 Y)
          );if
          (if (< X X1)(setq X1 X))
          (if (< Y Y1)(setq Y1 Y))
        );foreach
      );foreach
      (if (or (< X1 0)(< Y1 0))
        (progn
          (cond
            ((and (< X1 0)(< Y1 0))(setq MovePt (list X1 Y1)))
            ((< X1 0)(setq MovePt (list X1 0)))
            ((< Y1 0)(setq MovePt (list 0 Y1)))
          );cond
          (command "UCS" "M" MovePt)
        );progn
      );if
      (setq First t)
      (foreach List@ Textboxes@
        (foreach Pt List@
          (setq Ang~ (- (angle Zero Pt) AngEntity~))
          (setq Pt (polar Zero Ang~ (distance Zero Pt)))
          (setq X (car Pt) Y (cadr Pt))
          (if First
            (setq First nil X1 X X3 X Y1 Y Y3 Y)
          );if
          (if (< X X1)(setq X1 X))
          (if (< Y Y1)(setq Y1 Y))
          (if (> X X3)(setq X3 X))
          (if (> Y Y3)(setq Y3 Y))
        );foreach
      );foreach
      (command "UCS" "W")
      (setq NewPts@ (list (list X1 Y1)(list X3 Y1)(list X3 Y3)(list X1 Y3)))
      (foreach Pt NewPts@
        (setq Ang~ (+ (angle Zero Pt) AngEntity~))
        (setq Pt (polar Zero Ang~ (distance Zero Pt)))
        (setq Return@ (append Return@ (list Pt)))
      );foreach
    );case
  );cond
  Return@
);defun Text-Box
;-------------------------------------------------------------------------------
(princ)

liminnet · 发表于 2009-12-18 18:23:00

提示: 作者被禁止或删除内容自动屏蔽

liminnet · 发表于 2009-12-18 18:25:00

提示: 作者被禁止或删除内容自动屏蔽

carrot1983 · 发表于 2009-12-18 18:46:00

谢谢xianaihua

dajio · 发表于 2009-12-18 19:02:00

caoyin 版主，能否看一下你的算法？

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

[求助]TextBox函数有时不灵了

本帖子中包含更多资源

本帖子中包含更多资源

点评

回复：（carrot1983）将字体附上。可能跟字体有关系。...

liminnet liminnet 当前离线积分 9742 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2009-12-18 13:17:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

liminnet liminnet 当前离线积分 9742 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2009-12-18 18:23:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

liminnet liminnet 当前离线积分 9742 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2009-12-18 18:25:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡