grread的正交，功力不够，求大佬加持！！！

yaojing38

事情是，，想获得选取文字后面会拉出一条跟随的正交直线，，，但是不太熟悉grread的高深，，感觉获得了PT点，，线也画出来了但是，文字却移动了十万八千里，，，有点蒙，，请有空大家帮看看！谢谢！代码实现了画不是正交的斜线。。。。感觉就差一步。。。。但又感觉还好远。。。。无奈！

2. 
   
3. ;;-------------------------------------------------
   
4. (defun c:tt ()
   
5.   ;(setq pt0 (getpoint))
   
6.   (setvar 'orthomode 1)
   
7.   (setq a  (entsel))
   
8.   (setq pt0 (cadr a))
   
9.   (setq pt1 (cadr a))
   
10.   (setq ty (car a) )
    
11.   (setq enx (entget ty)
    
12.       txtpp (textbox enx)
    
13.     zg (cadr(cadr txtpp))
    
14.    
    
15.   )
    
16.   (command "line" pt0)
    
17.   (setq e(vlax-ename->vla-object ty))
    
18.   (setq loop t)
    
19.   (while loop
    
20.     (setq gr (grread t 15 0))
    
21.     (setq pt (trans (cadr gr) 1 0))
    
22.    
    
23.     (cond
    
24.       
    
25.       ;((equal gr '(2 15))    ;F8切换正交开关
    
26.       ;      (if (= f8 0)
    
27.       ;        (progn (setq f8 1) (princ "\n <正交 开>"))
    
28.       ;        (progn (setq f8 0) (princ "\n <正交 关>"))
    
29.       ;      )
    
30.       ;      (setvar 'orthomode f8)
    
31.       ;      (redraw)
    
32.       ;    )
    
33.       ((= 5 (car gr))
    
34.         ;(vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
    
35.         (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
    
36.         
    
37.         (redraw)
    
38.        (grdraw pt1 pt 255)
    
39.         (setq pt0 pt)
    
40.       )
    
41.       ((or (= 3 (car gr)) (= 32 (cadr gr)))
    
42.         (setq loop nil)
    
43.         (setq pt (polar pt1  (angle pt1 pt) (- (distance pt1 pt) (/ zg 3))))
    
44.         (command pt "")
    
45.         (redraw)
    
46.       )
    
47.     )
    
48.   )
    
49. 
    
50.   
    
51.   
    
52.   
    
53. )
    
54. ;;-------------------------------------------------
    
55. 
    

<br /> ;;-------------------------------------------------<br /> (defun c:tt ()<br />   ;(setq pt0 (getpoint))<br />   (setvar 'orthomode 1)<br />   (setq a  (entsel))<br />   (setq pt0 (cadr a))<br />   (setq pt1 (cadr a))<br />   (setq ty (car a) )<br />   (setq enx (entget ty)<br />       txtpp (textbox enx)<br />     zg (cadr(cadr txtpp))<br />     <br />   )<br />   (command "line" pt0)<br />   (setq e(vlax-ename->vla-object ty))<br />   (setq loop t)<br />   (while loop<br />     (setq gr (grread t 15 0))<br />     (setq pt (trans (cadr gr) 1 0))<br />     <br />     (cond <br />       <br />       ;((equal gr '(2 15))    ;F8切换正交开关<br />       ;      (if (= f8 0)<br />       ;        (progn (setq f8 1) (princ "\n <正交 开>"))<br />       ;        (progn (setq f8 0) (princ "\n <正交 关>"))<br />       ;      )<br />       ;      (setvar 'orthomode f8) <br />       ;      (redraw)<br />       ;    )<br />       ((= 5 (car gr))<br />         ;(vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))<br />         (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))<br />         <br />         (redraw)<br />        (grdraw pt1 pt 255) <br />         (setq pt0 pt)<br />       )<br />       ((or (= 3 (car gr)) (= 32 (cadr gr)))<br />         (setq loop nil)<br />         (setq pt (polar pt1  (angle pt1 pt) (- (distance pt1 pt) (/ zg 3))))<br />         (command pt "")<br />         (redraw)<br />       )<br />     )<br />   )<br /> <br />   <br />   <br />   <br /> )<br /> ;;-------------------------------------------------<br /> <br />

Bao_lai

第37行修改：(grdraw (list (car pt) (cadr pt1)) pt 1 8)
我测试文字没有飞，看你是否可能处在ucs下面，不是wcs需要坐标转换，不然文字会飞。

liuhe

grread 没有捕捉功能

linzenghuo

过来看看

cghdy

yaojing38

谢谢1楼的帮助，写的有点乱总归实现了，，在前辈的代码基础上，给有需要的人。。。。

2. 
   
3. ;;-------------------------------------------------
   
4. (defun c:tt ( / a ang ang1 ang3 e enx gr loop pt pt0 pt1 pt11 txtpp ty zg)
   
5.         (setvar 'orthomode 0)
   
6.         (setq a  (entsel))
   
7.         (setq pt0 (cadr a))
   
8.         (setq pt1 (cadr a))
   
9.         (setq ty (car a) )
   
10.         (setq enx (entget ty)
    
11.                   txtpp (textbox enx)
    
12.                 zg (cadr(cadr txtpp))
    
13.         )
    
14.   (command "line" pt0)
    
15.         (setq e(vlax-ename->vla-object ty))
    
16.         (setq loop t)
    
17.   (while loop
    
18.     (setq gr (grread t 15 0))
    
19.     (setq pt (trans (cadr gr) 1 0))
    
20.         (cond
    
21.                        
    
22.                         ;((equal gr '(2 15))    ;F8切换正交开关
    
23.                         ;                        (if (= f8 0)
    
24.                         ;                                (progn (setq f8 1) (princ "\n <正交 开>"))
    
25.                         ;                                (progn (setq f8 0) (princ "\n <正交 关>"))
    
26.                         ;                        )
    
27.                         ;                        (setvar 'orthomode f8)
    
28.                         ;                        (redraw)
    
29.                         ;                )
    
30.       ((= 5 (car gr))
    
31.                         (setq ang (atoi (angtos (angle pt1 pt))))
    
32.                         (if(> ang 315)(setq ang (- 360 ang)))
    
33.                         (cond ((and (< ang 45) (> ang -45))
    
34.                   (setq pt (list (car pt) (cadr pt1)))
    
35.                   )
    
36.                   ((and (< ang 135) (> ang 45))
    
37.                    (setq pt (list (car pt1) (cadr pt)))
    
38.                   )
    
39.                   ((and (< ang 225) (> ang 135))
    
40.                    (setq pt (list (car pt) (cadr pt1)))
    
41.                   )
    
42.                   ((and (< ang 315) (> ang 225))
    
43.                    (setq pt (list (car pt1) (cadr pt)))
    
44.                   )
    
45.             )
    
46.                                 (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
    
47.                                 (redraw)
    
48.                                 (grdraw pt1 pt 255)
    
49.                                 (setq pt0 pt)
    
50.       )
    
51.       ((or (= 3 (car gr)) (= 32 (cadr gr)))
    
52.         (setq loop nil)
    
53.                                 (setq ang3 (rem (angle pt0 pt) (* 1 pi )))
    
54.                                 (setq ang1 (rem (angle pt0 pt) (* 1 pi )))
    
55.                        
    
56.                                 (cond
    
57.                                 ((and (< (car pt0) (car pt1)) )
    
58.                
    
59.                                 (setq ang1 (+ ang1 (* 0.5 pi)))
    
60.                                 )
    
61.                                 ((and (> (car pt0) (car pt1)) )
    
62.                
    
63.                                 (setq ang1 (- ang1 (* 0.5 pi)))
    
64.                                 )
    
65.                                 ((and  (> (cadr pt0) (cadr pt1)))
    
66.                                
    
67.                                 (setq ang1 (+ ang1 (* 0.5 pi)))
    
68.                                 )
    
69.                                 ((and  (< (cadr pt0) (cadr pt1)))
    
70.                
    
71.                                 (setq ang1 (- ang1 (* 0.5 pi)))
    
72.                                 )
    
73. 
    
74.                         )
    
75.                                 (setq pt11 (polar pt1  ang1 (- (distance pt1 pt) (/ zg 2))))
    
76.               (command pt11 "")
    
77.                                 (redraw)
    
78.       )
    
79.     )
    
80.   )
    
81. )
    
82. ;;-------------------------------------------------
    
83. 
    

<br /> ;;-------------------------------------------------<br /> (defun c:tt ( / a ang ang1 ang3 e enx gr loop pt pt0 pt1 pt11 txtpp ty zg)<br />         (setvar 'orthomode 0)<br />         (setq a  (entsel))<br />         (setq pt0 (cadr a))<br />         (setq pt1 (cadr a))<br />         (setq ty (car a) )<br />         (setq enx (entget ty)<br />                   txtpp (textbox enx)<br />                 zg (cadr(cadr txtpp))<br />         )<br />   (command "line" pt0)<br />         (setq e(vlax-ename->vla-object ty))<br />         (setq loop t)<br />   (while loop<br />     (setq gr (grread t 15 0))<br />     (setq pt (trans (cadr gr) 1 0))<br />         (cond <br />                         <br />                         ;((equal gr '(2 15))    ;F8切换正交开关<br />                         ;                        (if (= f8 0)<br />                         ;                                (progn (setq f8 1) (princ "\n <正交 开>"))<br />                         ;                                (progn (setq f8 0) (princ "\n <正交 关>"))<br />                         ;                        )<br />                         ;                        (setvar 'orthomode f8) <br />                         ;                        (redraw)<br />                         ;                )<br />       ((= 5 (car gr))<br />                         (setq ang (atoi (angtos (angle pt1 pt))))<br />                         (if(> ang 315)(setq ang (- 360 ang)))<br />                         (cond ((and (< ang 45) (> ang -45))<br />                   (setq pt (list (car pt) (cadr pt1)))<br />                   )<br />                   ((and (< ang 135) (> ang 45))<br />                    (setq pt (list (car pt1) (cadr pt)))<br />                   )<br />                   ((and (< ang 225) (> ang 135))<br />                    (setq pt (list (car pt) (cadr pt1)))<br />                   )<br />                   ((and (< ang 315) (> ang 225))<br />                    (setq pt (list (car pt1) (cadr pt)))<br />                   )<br />             )<br />                                 (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))<br />                                 (redraw)<br />                                 (grdraw pt1 pt 255) <br />                                 (setq pt0 pt)<br />       )<br />       ((or (= 3 (car gr)) (= 32 (cadr gr)))<br />         (setq loop nil)<br />                                 (setq ang3 (rem (angle pt0 pt) (* 1 pi )))<br />                                 (setq ang1 (rem (angle pt0 pt) (* 1 pi )))<br />                         <br />                                 (cond <br />                                 ((and (< (car pt0) (car pt1)) )<br />                 <br />                                 (setq ang1 (+ ang1 (* 0.5 pi)))<br />                                 )<br />                                 ((and (> (car pt0) (car pt1)) )<br />                 <br />                                 (setq ang1 (- ang1 (* 0.5 pi)))<br />                                 )<br />                                 ((and  (> (cadr pt0) (cadr pt1)))<br />                                 <br />                                 (setq ang1 (+ ang1 (* 0.5 pi)))<br />                                 )<br />                                 ((and  (< (cadr pt0) (cadr pt1)))<br />                 <br />                                 (setq ang1 (- ang1 (* 0.5 pi)))<br />                                 )<br /> <br />                         )<br />                                 (setq pt11 (polar pt1  ang1 (- (distance pt1 pt) (/ zg 2))))<br />               (command pt11 "")<br />                                 (redraw)<br />       )<br />     )<br />   )<br /> )<br /> ;;-------------------------------------------------<br /> <br />