[讨论]：请捉虫子，一段提取text对象中单个文字的代码

zml84

2. 
   
3. ;|;;
   
4. 日期：2008-03-07晚
   
5. 备忘:关于text对象中单个文字位置的计算
   
6. 
   
7. ;;|;
   
8. ;;;=========================================
   
9. ;;;功能：获取TEXT对象中指定坐标位置的字符
   
10. ;;;参数：EN ----text对象组码表
    
11. ;;;      PT ----指定坐标位置（世界坐标系下）
    
12. ;;;返回：若有，返回单个字符；若无，nil
    
13. ;;;日期：zml84 于 2008-03-07
    
14. (defun TT (ENT PT / ANG II LST PT0 PTA PTB PT_ANG PT_DIST STR STRI WI)
    
15.     ;;插入点  角度  内容
    
16.     (setq PT0 (cdr (assoc 10 ENT))
    
17.           ANG (cdr (assoc 50 ENT))
    
18.           STR (cdr (assoc 1 ENT))
    
19.     )
    
20.     ;;局部坐标系两点
    
21.     (setq LST (textbox ENT))
    
22.     (setq PTA (car LST)
    
23.           PTB (cadr LST)
    
24.     )
    
25.     ;;///////////////////////////////////////
    
26.     ;;将pt由世界坐标系转化为TEXT局部坐标系
    
27.     ;;1.平移坐标系
    
28.     (setq PT (mapcar '- PT PT0))
    
29.     ;;2.旋转坐标系
    
30.     (setq PT_DIST (distance '(0 0 0) PT)
    
31.           PT_ANG  (angle '(0 0 0) PT)
    
32.           PT          (polar '(0 0 0) (- PT_ANG ANG) PT_DIST)
    
33.     )
    
34.     ;;///////////////////////////////////////
    
35.     ;;判断pt是否在文字包围盒中
    
36.     (if        (and (< (car PTA) (car PT) (car PTB))
    
37.              (< (cadr PTA) (cadr PT) (cadr PTB))
    
38.         )
    
39.         (progn
    
40.             ;;计算单个字符宽度
    
41.             (setq WI (/ (- (car PTB) (car PTA)) 1.0 (strlen STR)))
    
42.             (setq II (fix (/ (- (car PT) (car PTA)) WI)))
    
43.             ;;////////////////////////////////////////////////////
    
44.             ;;拆分字符串，构建查询用表
    
45.             ;;例如："汉12" 拆分为：("汉" "汉" "字" "字" "1" "2")
    
46.             (setq LST '()) ;_存放结果的变量
    
47.             (while (/= STR "")
    
48.                 (if (> (ascii (substr STR 1 1)) 159)
    
49.                     (setq STRI (substr STR 1 2)
    
50.                           LST  (cons STRI LST)
    
51.                           LST  (cons STRI LST)
    
52.                           STR  (substr STR 3)
    
53.                     )
    
54.                     (setq STRI (substr STR 1 1)
    
55.                           LST  (cons STRI LST)
    
56.                           STR  (substr STR 2)
    
57.                     )
    
58.                 )
    
59.             )
    
60.             (setq LST (reverse LST))
    
61.             ;;////////////////////////////////////////////////////
    
62.             ;;查询得到结果
    
63.             (nth II LST)
    
64.         )
    
65.         NIL
    
66.     )
    
67. ) ;_结束 dufun
    
68. 
    
69. 
    
70. ;;;==================================
    
71. ;;;功能：测试
    
72. (defun C:TT (/ SS ENT PT)
    
73.     (while (setq SS (entsel "\n请点取TEXT对象: "))
    
74.         (setq ENT (entget (car SS)))
    
75.         (if (= (cdr (assoc 0 ENT)) "TEXT")
    
76.             (while (setq PT (getpoint "\n指定点: "))
    
77.                 (setq PT (trans PT 1 0))
    
78.                 (princ (TT ENT PT))
    
79.             )
    
80.         )
    
81.     )
    
82.     (princ)
    
83. )
    
84. ;;;==================================
    
85. ;;;功能：测试2
    
86. (defun C:TT2 (/ SS ENT PT)
    
87.     (while (setq SS (entsel "\n请点取TEXT对象中的文字: "))
    
88.         (setq ENT (entget (car SS))
    
89.               PT  (cadr SS)
    
90.               PT  (trans PT 1 0)
    
91.         )
    
92.         (if (= (cdr (assoc 0 ENT)) "TEXT")
    
93.             (princ (TT ENT PT))
    
94.         )
    
95.     )
    
96.     (princ)
    
97. )
    

<br /> ;|;;<br /> 日期：2008-03-07晚<br /> 备忘:关于text对象中单个文字位置的计算<br /> <br /> ;;|;<br /> ;;;=========================================<br /> ;;;功能：获取TEXT对象中指定坐标位置的字符<br /> ;;;参数：EN ----text对象组码表<br /> ;;;      PT ----指定坐标位置（世界坐标系下）<br /> ;;;返回：若有，返回单个字符；若无，nil<br /> ;;;日期：zml84 于 2008-03-07<br /> (defun TT (ENT PT / ANG II LST PT0 PTA PTB PT_ANG PT_DIST STR STRI WI)<br />     ;;插入点  角度  内容<br />     (setq PT0 (cdr (assoc 10 ENT))<br />           ANG (cdr (assoc 50 ENT))<br />           STR (cdr (assoc 1 ENT))<br />     )<br />     ;;局部坐标系两点<br />     (setq LST (textbox ENT))<br />     (setq PTA (car LST)<br />           PTB (cadr LST)<br />     )<br />     ;;///////////////////////////////////////<br />     ;;将pt由世界坐标系转化为TEXT局部坐标系<br />     ;;1.平移坐标系<br />     (setq PT (mapcar '- PT PT0))<br />     ;;2.旋转坐标系<br />     (setq PT_DIST (distance '(0 0 0) PT)<br />           PT_ANG  (angle '(0 0 0) PT)<br />           PT          (polar '(0 0 0) (- PT_ANG ANG) PT_DIST)<br />     )<br />     ;;///////////////////////////////////////<br />     ;;判断pt是否在文字包围盒中<br />     (if        (and (< (car PTA) (car PT) (car PTB))<br />              (< (cadr PTA) (cadr PT) (cadr PTB))<br />         )<br />         (progn<br />             ;;计算单个字符宽度<br />             (setq WI (/ (- (car PTB) (car PTA)) 1.0 (strlen STR)))<br />             (setq II (fix (/ (- (car PT) (car PTA)) WI)))<br />             ;;////////////////////////////////////////////////////<br />             ;;拆分字符串，构建查询用表<br />             ;;例如："汉12" 拆分为：("汉" "汉" "字" "字" "1" "2")<br />             (setq LST '()) ;_存放结果的变量<br />             (while (/= STR "")<br />                 (if (> (ascii (substr STR 1 1)) 159)<br />                     (setq STRI (substr STR 1 2)<br />                           LST  (cons STRI LST)<br />                           LST  (cons STRI LST)<br />                           STR  (substr STR 3)<br />                     )<br />                     (setq STRI (substr STR 1 1)<br />                           LST  (cons STRI LST)<br />                           STR  (substr STR 2)<br />                     )<br />                 )<br />             )<br />             (setq LST (reverse LST))<br />             ;;////////////////////////////////////////////////////<br />             ;;查询得到结果<br />             (nth II LST)<br />         )<br />         NIL<br />     )<br /> ) ;_结束 dufun<br /> <br /> <br /> ;;;==================================<br /> ;;;功能：测试<br /> (defun C:TT (/ SS ENT PT)<br />     (while (setq SS (entsel "\n请点取TEXT对象: "))<br />         (setq ENT (entget (car SS)))<br />         (if (= (cdr (assoc 0 ENT)) "TEXT")<br />             (while (setq PT (getpoint "\n指定点: "))<br />                 (setq PT (trans PT 1 0))<br />                 (princ (TT ENT PT))<br />             )<br />         )<br />     )<br />     (princ)<br /> )<br /> ;;;==================================<br /> ;;;功能：测试2<br /> (defun C:TT2 (/ SS ENT PT)<br />     (while (setq SS (entsel "\n请点取TEXT对象中的文字: "))<br />         (setq ENT (entget (car SS))<br />               PT  (cadr SS)<br />               PT  (trans PT 1 0)<br />         )<br />         (if (= (cdr (assoc 0 ENT)) "TEXT")<br />             (princ (TT ENT PT))<br />         )<br />     )<br />     (princ)<br /> )<br />

xshrimp

不太准确..
用一下文字测试.
[php]text中文搜索框□■＞≥%%p0.00%%C%%d中华人民共和国国家主席
[/php]

它山之石

http://www.xdcad.net/forum/showthread.php?threadid=248026

xyp1964

文编大全之框选插入

dhxf

文编大全哪来可以找到