(XD::Text:PointAtIndex）获得文字（块内、属性文字）指定索引位置字符的包围框

Lispboy

1. (defun XD::Text:PointAtIndex (e inx / base box box1 box2 cur ed ed1 i lastpt
   
2.                                 len p2 pos prev tf txt typ v xdir
   
3.                              )
   
4.   (if (setq txt (xdrx_getpropertyvalue e "textstring"))
   
5.     (progn
   
6.       (setq ed (entget e)
   
7.             box(xdrx_text_box e)
   
8.             ydir (mapcar '- (nth 2 box)(nth 1 box))
   
9.       )      
   
10.       (setq len (xdrx_string_length txt))
    
11.       (if (>= inx len)
    
12.         (setq inx (1- len))
    
13.       )
    
14.       (if (< inx 0)
    
15.         (setq inx 0)
    
16.       )
    
17.       (setq tf t
    
18.             i 0
    
19.       )
    
20.       (setq box2 (xdrx_text_box e)
    
21.             base (car box2)
    
22.             lastpt base
    
23.             xdir (xd::entity:xdir e)
    
24.       )
    
25.       (while (and
    
26.                tf
    
27.                (<= i inx)
    
28.              )
    
29.         (setq prev (xdrx_string_mid txt 0 (1+ i)))
    
30.         (setq ed (subst
    
31.                    (cons 1 prev)
    
32.                    (assoc 1 ed)
    
33.                    ed
    
34.                  )
    
35.         )
    
36.         (setq cur (xdrx_string_mid txt i 1)
    
37.               ed1 (subst
    
38.                     (cons 1 cur)
    
39.                     (assoc 1 ed)
    
40.                     ed
    
41.                   )
    
42.               box1 (textbox ed1)
    
43.         )
    
44.         (setq box (textbox ed)
    
45.               v (mapcar
    
46.                   '-
    
47.                   (cadr box)
    
48.                   (car box)
    
49.                 )
    
50.               p2 (if (< i (1- len))
    
51.                    (mapcar
    
52.                      '+
    
53.                      base
    
54.                      (xdrx_vector_product xdir (+ (caar box1) (car v))
    
55. 
    
56.                      )
    
57.                    )
    
58.                    (cadr box2)
    
59. 
    
60.                  )
    
61.         )
    
62.         (if (= i inx)
    
63.           (setq pos (list lastpt p2 (mapcar '+ p2 ydir)(mapcar '+ lastpt ydir)))
    
64.         )
    
65.         (setq lastpt p2
    
66.               i (1+ i)
    
67.         )
    
68.       )
    
69.     )
    
70.   )
    
71.   pos
    
72. )

(defun XD::Text:PointAtIndex (e inx / base box box1 box2 cur ed ed1 i lastpt<br />                                 len p2 pos prev tf txt typ v xdir<br />                              )<br />   (if (setq txt (xdrx_getpropertyvalue e "textstring"))<br />     (progn<br />       (setq ed (entget e)<br />             box(xdrx_text_box e)<br />             ydir (mapcar '- (nth 2 box)(nth 1 box))<br />       )      <br />       (setq len (xdrx_string_length txt))<br />       (if (>= inx len)<br />         (setq inx (1- len))<br />       )<br />       (if (< inx 0)<br />         (setq inx 0)<br />       )<br />       (setq tf t<br />             i 0<br />       )<br />       (setq box2 (xdrx_text_box e)<br />             base (car box2)<br />             lastpt base<br />             xdir (xd::entity:xdir e)<br />       )<br />       (while (and<br />                tf<br />                (<= i inx)<br />              )<br />         (setq prev (xdrx_string_mid txt 0 (1+ i)))<br />         (setq ed (subst<br />                    (cons 1 prev)<br />                    (assoc 1 ed)<br />                    ed<br />                  )<br />         )<br />         (setq cur (xdrx_string_mid txt i 1)<br />               ed1 (subst<br />                     (cons 1 cur)<br />                     (assoc 1 ed)<br />                     ed<br />                   )<br />               box1 (textbox ed1)<br />         )<br />         (setq box (textbox ed)<br />               v (mapcar<br />                   '-<br />                   (cadr box)<br />                   (car box)<br />                 )<br />               p2 (if (< i (1- len))<br />                    (mapcar<br />                      '+<br />                      base<br />                      (xdrx_vector_product xdir (+ (caar box1) (car v))<br /> <br />                      )<br />                    )<br />                    (cadr box2)<br /> <br />                  )<br />         )<br />         (if (= i inx)<br />           (setq pos (list lastpt p2 (mapcar '+ p2 ydir)(mapcar '+ lastpt ydir)))<br />         )<br />         (setq lastpt p2<br />               i (1+ i)<br />         )<br />       )<br />     )<br />   )<br />   pos<br /> )

开水瓶游泳

(vl-load-com)

dyjwyqz5221

此函数对于文字中的空格是有些问题的。

dyjwyqz5221

修改下次函数的获取字符串顺序就会些了。