关于取文本四个角点的通用函数（get-textbox）的解析与测试源码
本帖最后由 林霄云 于 2014-1-4 21:03 编辑关于取文本四个角点的通用函数（get-textbox）的解析与测试源码
江湖上取文本框四角点的函数各种各种，本文贴出自认为较为合适的可读性可改造性较强的做法。欢迎指点！
为了方便测试，代码加入while循环与entsel选择。(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日
;(setq oldosmode (getvar "osmode"))
;(setvar "osmode" 0)
(princ "\n取文本")
(while (setq en (car (entsel)));当作为通用函数时，en作用参数，取消while循环
(setq ent (entget en))
(setq pt-ins (cdr (assoc 10 ent)));第一对齐点（在 OCS 中）插入点(非UCS下坐标点)
(setq ang (cdr (assoc 50 ent))) ;a 文字旋转角度 弧度
(setq pt-list (textbox ent)) ;取虚拟框
(setq pt0-ll (car pt-list)) ;取左下点
(setq pt0-tr (cadr pt-list)) ;取右上点
(setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。
(setqbox-length (car box-tr))
(setqbox-height (cadr box-tr))
(setq ang-self (atan (cadr box-tr) (car box-tr)));取转角，基点为原点。 self-ang花了作者一晚上的时间，因为polar中的角度是从坐标轴开始的。需要加自身转角。
(setq dis(distance '(0.0 0.0 0.0) box-tr))
(setq pt-3 (polar pt-ins (+ ang-self ang) dis));此句+ ang-self 表示逆时针（polar正方向）转角ang-self
(setq pt-2 (polar pt-insang box-length))
(setq pt-4 (polar pt-ins (+ ang (*0.5 pi) ) box-height)) ;此句+0.5pi 表示逆时针（polar正方向）转角90°
;(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 ，测试文本外框代码
(list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向
) ;while 加入循环
;(setvar "osmode" oldosmode) ;取消捕捉，当使用command命令时。
;(princ)
);defun
(princ "\nget-textbox 获取文本四角点 命令加载成功\nDesigned by 林霄云 2014年1月4日")
(princ)
结论：本代码经过wcs和ucs下的测试。 定义一牛函数点偏移offset_point(defun offset_point(pt x y x-ang / pt1 pt2 )
;Designed by 林霄云 2014年4月20日
;点偏移。x y 平移量，x-ang 基准线弧度
(setq pt1 (polar pt x-ang x))
(setq pt2 (polar pt1 (+ x-ang (* 0.5 pi)) y))
pt2
)然后get_textbox函数修改如下，变得更具有可读性。(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 )
;Designed by 林霄云 2014年4月20日
;获取文本四角点 Get TextBox ，坐下点起逆时针
(setq ent (entget en))
(setq pt-ins (cdr (assoc 10 ent)));第一对齐点（在 OCS 中）插入点(非UCS下坐标点)
(setq ang (cdr (assoc 50 ent))) ;a 文字旋转角度 弧度
(setq pt-list (textbox ent)) ;取虚拟框
(setq pt0-ll (car pt-list)) ;取左下点
(setq pt0-tr (cadr pt-list)) ;取右上点
(setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr)) ;取对应原点的右上点。
(setqbox-length (car box-tr))
(setqbox-height (cadr box-tr))
(setq pt-2 (offset_point pt-ins box-length 0 ang)
pt-4 (offset_point pt-ins 0 box-height ang)
pt-3 (offset_point pt-ins box-length box-height ang))
;(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 ，测试文本外框代码
(list pt-ins pt-2 pt-3 pt-4) ;逆时针顺序，即polar函数规定的正方向
);defun 提点意见，不妥之处请原谅。
程序中没有坐标转换，估计仅适合于OCS与WCS一致的情况（即文字在WCS的XY平面上的情况） ucs测试没成功! liu_kunlun 发表于 2014-1-4 21:17
提点意见，不妥之处请原谅。
程序中没有坐标转换，估计仅适合于OCS与WCS一致的情况（即文字在WCS的XY平面上 ...
对于本文，文字，其OCS与WCS是一致的，没有发现特例，如有望提供。 yoyoho 发表于 2014-1-5 09:04
ucs测试没成功!
本文提供的测试代码。UCS测试可行。请检查自己的测试代码。 绝大情况下，为平面制图，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 static/image/common/back.gif
绝大情况下，为平面制图，OCS与WCS是一致的。
你新建一个UCS，(command "ucs" "n" "3" '(0. 0. 0.) '(1. 0 ...
感谢提供实例。孤陋寡闻了。所以这篇文章标题得加上，支持与WCS某轴平行的UCS（受限的UCS），满足常见的工程应用。再次谢谢！ 感谢林工把体会让朋友们分享 非常感谢，学习下。
页:
[1]
2