关于取文本四个角点的通用函数（get-textbox）的解析与测试源码

林霄云

关于取文本四个角点的通用函数（get-textbox）的解析与测试源码
江湖上取文本框四角点的函数各种各种，本文贴出自认为较为合适的可读性可改造性较强的做法。欢迎指点！
为了方便测试，代码加入while循环与entsel选择。

2. (defun get-textbox ( /  ang-self ang en ent pt0-ll pt0-tr pt-ins pt-2 pt-3 pt-4 pt-list x y ) ;获取文本四角点Designed by 林霄云 2014年1月4日
   
3. ;(setq oldosmode (getvar "osmode"))
   
4. ;(setvar "osmode" 0)
   
5. 
   
6. (princ "\n取文本")
   
7. (while (setq en (car (entsel)));当作为通用函数时，en作用参数，取消while循环
   
8. 
   
9. (setq ent (entget en))
   
10. (setq pt-ins (cdr (assoc 10 ent)))  ;第一对齐点（在 OCS 中）插入点(非UCS下坐标点)
    
11. (setq ang (cdr (assoc 50 ent)))    ;a 文字旋转角度 弧度
    
12.         
    
13. (setq pt-list (textbox ent))    ;取虚拟框
    
14. (setq pt0-ll (car pt-list))      ;取左下点
    
15. (setq pt0-tr (cadr pt-list))    ;取右上点
    
16. 
    
17. (setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。
    
18. 
    
19. (setq  box-length (car box-tr))
    
20. (setq  box-height (cadr box-tr))
    
21. 
    
22. (setq ang-self (atan (cadr box-tr) (car box-tr)));取转角，基点为原点。 self-ang花了作者一晚上的时间，因为polar中的角度是从坐标轴开始的。需要加自身转角。
    
23. 
    
24. (setq dis  (distance '(0.0 0.0 0.0) box-tr))
    
25. (setq pt-3 (polar pt-ins (+ ang-self ang) dis));此句+ ang-self 表示逆时针（polar正方向）转角ang-self
    
26. (setq pt-2 (polar pt-ins  ang box-length))
    
27. (setq pt-4 (polar pt-ins (+ ang (*  0.5 pi) ) box-height)) ;此句+0.5pi 表示逆时针（polar正方向）转角90°
    
28. ;(command "line" (trans pt-ins 0 1) (trans pt-2 0 1) (trans pt-3 0 1) (trans pt-4 0 1 ) "c") ;trans pt 0 1 wcs 转 ucs ，测试文本外框代码
    
29. (list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向
    
30. 
    
31.   ) ;while 加入循环
    
32. 
    
33. ;(setvar "osmode" oldosmode)    ;取消捕捉，当使用command命令时。
    
34. ;(princ)
    
35. );defun
    
36. 
    
37. (princ "\nget-textbox 获取文本四角点 命令加载成功\nDesigned by 林霄云 2014年1月4日")
    
38. (princ)
    

(defun get-textbox ( /  ang-self ang en ent pt0-ll pt0-tr pt-ins pt-2 pt-3 pt-4 pt-list x y ) ;获取文本四角点Designed by 林霄云 2014年1月4日<br /> ;(setq oldosmode (getvar "osmode"))<br /> ;(setvar "osmode" 0)<br /> <br /> (princ "\n取文本")<br /> (while (setq en (car (entsel)));当作为通用函数时，en作用参数，取消while循环<br /> <br /> (setq ent (entget en))<br /> (setq pt-ins (cdr (assoc 10 ent)))  ;第一对齐点（在 OCS 中）插入点(非UCS下坐标点)<br /> (setq ang (cdr (assoc 50 ent)))    ;a 文字旋转角度 弧度<br />         <br /> (setq pt-list (textbox ent))    ;取虚拟框<br /> (setq pt0-ll (car pt-list))      ;取左下点<br /> (setq pt0-tr (cadr pt-list))    ;取右上点<br /> <br /> (setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。<br /> <br /> (setq  box-length (car box-tr)) <br /> (setq  box-height (cadr box-tr))<br /> <br /> (setq ang-self (atan (cadr box-tr) (car box-tr)));取转角，基点为原点。 self-ang花了作者一晚上的时间，因为polar中的角度是从坐标轴开始的。需要加自身转角。<br /> <br /> (setq dis  (distance '(0.0 0.0 0.0) box-tr))<br /> (setq pt-3 (polar pt-ins (+ ang-self ang) dis));此句+ ang-self 表示逆时针（polar正方向）转角ang-self<br /> (setq pt-2 (polar pt-ins  ang box-length))<br /> (setq pt-4 (polar pt-ins (+ ang (*  0.5 pi) ) box-height)) ;此句+0.5pi 表示逆时针（polar正方向）转角90°<br /> ;(command "line" (trans pt-ins 0 1) (trans pt-2 0 1) (trans pt-3 0 1) (trans pt-4 0 1 ) "c") ;trans pt 0 1 wcs 转 ucs ，测试文本外框代码<br /> (list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向<br /> <br />   ) ;while 加入循环<br /> <br /> ;(setvar "osmode" oldosmode)    ;取消捕捉，当使用command命令时。<br /> ;(princ)<br /> );defun<br /> <br /> (princ "\nget-textbox 获取文本四角点 命令加载成功\nDesigned by 林霄云 2014年1月4日")<br /> (princ)<br />

结论：本代码经过wcs和ucs下的测试。

林霄云

定义一牛函数点偏移offset_point

2. (defun offset_point(pt x y x-ang / pt1 pt2 )
   
3. ;Designed by 林霄云 2014年4月20日
   
4. ;点偏移。x y 平移量，x-ang 基准线弧度
   
5. (setq pt1 (polar pt x-ang x))
   
6. (setq pt2 (polar pt1 (+ x-ang (* 0.5 pi)) y))
   
7. pt2
   
8. )

(defun offset_point(pt x y x-ang / pt1 pt2 )<br /> ;Designed by 林霄云 2014年4月20日<br /> ;点偏移。x y 平移量，x-ang 基准线弧度<br /> (setq pt1 (polar pt x-ang x))<br /> (setq pt2 (polar pt1 (+ x-ang (* 0.5 pi)) y))<br /> pt2<br /> )

然后get_textbox函数修改如下，变得更具有可读性。

2. (defun get_textbox ( en /  ang-self ang en ent pt0-ll pt0-tr pt-ins pt-2 pt-3 pt-4 box-tr box-length box-height pt-list x y )
   
3. ;Designed by 林霄云 2014年4月20日
   
4. ;获取文本四角点 Get TextBox ，坐下点起逆时针
   
5. (setq ent (entget en))
   
6. (setq pt-ins (cdr (assoc 10 ent)))  ;第一对齐点（在 OCS 中）插入点(非UCS下坐标点)
   
7. (setq ang (cdr (assoc 50 ent)))    ;a 文字旋转角度 弧度
   
8.         
   
9. (setq pt-list (textbox ent))    ;取虚拟框
   
10. (setq pt0-ll (car pt-list))      ;取左下点
    
11. (setq pt0-tr (cadr pt-list))    ;取右上点
    
12. 
    
13. (setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。
    
14. 
    
15. (setq  box-length (car box-tr))
    
16. (setq  box-height (cadr box-tr))
    
17. 
    
18. (setq pt-2 (offset_point pt-ins box-length 0 ang)
    
19.     pt-4 (offset_point pt-ins 0 box-height ang)
    
20.     pt-3 (offset_point pt-ins box-length box-height ang))
    
21. ;(command "line" (trans pt-ins 0 1) (trans pt-2 0 1) (trans pt-3 0 1) (trans pt-4 0 1 ) "c") ;trans pt 0 1 wcs 转 ucs ，测试文本外框代码
    
22. (list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向
    
23. 
    
24. );defun

(defun get_textbox ( en /  ang-self ang en ent pt0-ll pt0-tr pt-ins pt-2 pt-3 pt-4 box-tr box-length box-height pt-list x y ) <br /> ;Designed by 林霄云 2014年4月20日<br /> ;获取文本四角点 Get TextBox ，坐下点起逆时针<br /> (setq ent (entget en))<br /> (setq pt-ins (cdr (assoc 10 ent)))  ;第一对齐点（在 OCS 中）插入点(非UCS下坐标点)<br /> (setq ang (cdr (assoc 50 ent)))    ;a 文字旋转角度 弧度<br />         <br /> (setq pt-list (textbox ent))    ;取虚拟框<br /> (setq pt0-ll (car pt-list))      ;取左下点<br /> (setq pt0-tr (cadr pt-list))    ;取右上点<br /> <br /> (setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。<br /> <br /> (setq  box-length (car box-tr)) <br /> (setq  box-height (cadr box-tr))<br /> <br /> (setq pt-2 (offset_point pt-ins box-length 0 ang)<br />     pt-4 (offset_point pt-ins 0 box-height ang)<br />     pt-3 (offset_point pt-ins box-length box-height ang))<br /> ;(command "line" (trans pt-ins 0 1) (trans pt-2 0 1) (trans pt-3 0 1) (trans pt-4 0 1 ) "c") ;trans pt 0 1 wcs 转 ucs ，测试文本外框代码<br /> (list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向<br /> <br /> );defun

liu_kunlun

提点意见，不妥之处请原谅。
程序中没有坐标转换，估计仅适合于OCS与WCS一致的情况（即文字在WCS的XY平面上的情况）

yoyoho

ucs测试没成功!

林霄云

liu_kunlun 发表于 2014-1-4 21:17
提点意见，不妥之处请原谅。
程序中没有坐标转换，估计仅适合于OCS与WCS一致的情况（即文字在WCS的XY平面上 ...

对于本文，文字，其OCS与WCS是一致的，没有发现特例，如有望提供。

林霄云

yoyoho 发表于 2014-1-5 09:04
ucs测试没成功!

本文提供的测试代码。UCS测试可行。请检查自己的测试代码。

liu_kunlun

绝大情况下，为平面制图，OCS与WCS是一致的。
你新建一个UCS，(command "ucs" "n" "3" '(0. 0. 0.) '(1. 0. 0.) '(0. 1. 1.))，再写文字，其OCS与WCS肯定不一致。

林霄云

liu_kunlun 发表于 2014-1-5 17:51
绝大情况下，为平面制图，OCS与WCS是一致的。
你新建一个UCS，(command "ucs" "n" "3" '(0. 0. 0.) '(1. 0 ...

感谢提供实例。孤陋寡闻了。所以这篇文章标题得加上，支持与WCS某轴平行的UCS（受限的UCS），满足常见的工程应用。再次谢谢！

ynhh

感谢林工把体会让朋友们分享

一心人

非常感谢，学习下。