[LISP函数]：取得text实体textbox的四个顶点

wkai

2. ;;;from [email]coolzhb@xdcad.net[/email]
   
3. ;;;参数：text实体名
   
4. ;;;返回值：text实体textbox的四个顶点
   
5. (defun xdl-text-corners(e / ANG COSROT EN NAME P0 P1 P2 P3 P4 SINROT T1 T2)
   
6.   (setq   en (entget e)
   
7.           p0 (cdr (assoc 10 en))
   
8.           name (cdr (assoc 1 en))
   
9.           ang (cdr (assoc 50 en))
   
10.           sinrot (sin ang)
    
11.           cosrot (cos ang)
    
12.           t1 (car (textbox en))
    
13.           t2 (cadr (textbox en))
    
14.           p1 (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
    
15.                    (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t1) cosrot)))
    
16.              )
    
17.           p2 (list (+ (car p0) (- (* (car t2) cosrot) (* (cadr t1) sinrot)))
    
18.                    (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t1) cosrot)))
    
19.              )
    
20.           p3 (list (+ (car p0) (- (* (car t2) cosrot) (* (cadr t2) sinrot)))
    
21.                    (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t2) cosrot)))
    
22.              )
    
23.           p4 (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t2) sinrot)))
    
24.                    (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t2) cosrot)))
    
25.              )         
    
26.     )
    
27.   (list p1 p2 p3 p4 )
    
28.   )
    

;;;from [email]coolzhb@xdcad.net[/email]<br /> ;;;参数：text实体名<br /> ;;;返回值：text实体textbox的四个顶点<br /> (defun xdl-text-corners(e / ANG COSROT EN NAME P0 P1 P2 P3 P4 SINROT T1 T2)<br />   (setq   en (entget e)<br />           p0 (cdr (assoc 10 en))<br />           name (cdr (assoc 1 en))<br />           ang (cdr (assoc 50 en))<br />           sinrot (sin ang)<br />           cosrot (cos ang)<br />           t1 (car (textbox en))<br />           t2 (cadr (textbox en))<br />           p1 (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))<br />                    (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t1) cosrot)))<br />              )<br />           p2 (list (+ (car p0) (- (* (car t2) cosrot) (* (cadr t1) sinrot)))<br />                    (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t1) cosrot)))<br />              )<br />           p3 (list (+ (car p0) (- (* (car t2) cosrot) (* (cadr t2) sinrot)))<br />                    (+ (cadr p0) (+ (* (car t2) sinrot) (* (cadr t2) cosrot)))<br />              )<br />           p4 (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t2) sinrot)))<br />                    (+ (cadr p0) (+ (* (car t1) sinrot) (* (cadr t2) cosrot)))<br />              )         <br />     )<br />   (list p1 p2 p3 p4 )<br />   )<br />

狂刀

2. 
   
3.   [FONT=courier new]
   
4. ;| 求wcs下text的四个外框(textbox)角点-----by 狂刀.2005.10
   
5. 参数: ent = 文本(text)实体名或实体表.
   
6. 返回: wcs下文本的四个外框角点.
   
7. |;
   
8. (defun xdl-tboxwcs (ent / p0 ang tb p1 p2 tb)
   
9.   (if (= 'ENAME (type ent))(setq ent (entget ent)))
   
10.   (setq p0 (cdr(assoc 10 ent))
    
11.         ang(cdr(assoc 50 ent)))
    
12.   (setq tb (textbox ent)
    
13.         p1 (car tb)
    
14.         p2 (cadr tb)
    
15.         tb (list p1 (list (car p1)(cadr p2)) p2 (list (car p2)(cadr p1))))
    
16.   (mapcar '(lambda(x)(polar p0 (+ ang (angle '(0. 0. 0.) x)) (distance '(0. 0. 0.) x))) tb)
    
17. )
    
18. 
    
19.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;| 求wcs下text的四个外框(textbox)角点-----by 狂刀.2005.10<br /> 参数: ent = 文本(text)实体名或实体表.<br /> 返回: wcs下文本的四个外框角点.<br /> |;<br /> (defun xdl-tboxwcs (ent / p0 ang tb p1 p2 tb)<br />   (if (= 'ENAME (type ent))(setq ent (entget ent)))<br />   (setq p0 (cdr(assoc 10 ent))<br />         ang(cdr(assoc 50 ent)))<br />   (setq tb (textbox ent)<br />         p1 (car tb)<br />         p2 (cadr tb)<br />         tb (list p1 (list (car p1)(cadr p2)) p2 (list (car p2)(cadr p1))))<br />   (mapcar '(lambda(x)(polar p0 (+ ang (angle '(0. 0. 0.) x)) (distance '(0. 0. 0.) x))) tb)<br /> )<br /> <br />   [/FONT]<br />

测试程序:
(defun c:t1 ()
  (apply 'command (cons ".pline" (mapcar '(lambda(x)(trans x 0 1))(xdl-tboxwcs (car(entsel))))))
  (command "")
)