(XD::Doc:GetCorner)与UCS平行的Getcorner

st788796

1. (defun XD::Doc:Getcorner (p msg clr xdir / con dynpt p1 p2 p4 pt ret v ydir)
   
2.   (defun callback (dynpt /)
   
3.     (setq pt (trans p 1 0)
   
4.           v (mapcar
   
5.               '-
   
6.               (setq p1 dynpt)
   
7.               pt
   
8.             )
   
9.           p2 (car (xd::pnts:orthoproject (list dynpt) pt (mapcar
   
10.                                                            '+
    
11.                                                            pt
    
12.                                                            xdir
    
13.                                                          )
    
14.                   )
    
15.              )
    
16.           p4 (car (xd::pnts:orthoproject (list dynpt) pt (mapcar
    
17.                                                            '+
    
18.                                                            pt
    
19.                                                            ydir
    
20.                                                          )
    
21.                   )
    
22.              )
    
23.     )
    
24.     (if (< (xdrx_point_dist2line dynpt pt p4) 0.0)
    
25.       (setq con 1)
    
26.       (setq con 0)
    
27.     )
    
28.     (redraw)
    
29.     (xdrx_grdraw clr con pt p2 dynpt p4 pt)
    
30.   )
    
31.   (if (not clr)
    
32.     (setq clr 1)
    
33.   )
    
34.   (setq clr (abs clr))
    
35. 
    
36.   (XD::Begin)
    
37.   (if (not xdir)
    
38.     (setq xdir (getvar "ucsxdir")
    
39.           ydir (getvar "ucsydir")
    
40.     )
    
41.     (progn
    
42.       (setq ydir (xdrx_vector_crossproduct (getvar "viewdir") xdir))
    
43.       (if (equal ydir '(0 0 0) 1e-3)
    
44.          (setq ydir (xdrx_vector_perpvector xdir))
    
45.       )
    
46.     )
    
47.   )
    
48.   (xdrx_pointmonitor "Callback" (xdrx_object_get "layer" "0"))
    
49.   (if (setq ret (getpoint msg))
    
50.     (setq ret (list (if (= con 0)
    
51.                       "WP"
    
52.                       "CP"
    
53.                     ) (xd::pnts:wcs2ucs (list pt p2 p1 p4))
    
54.               )
    
55.     )
    
56.   )
    
57.   (xdrx_pointmonitor)
    
58.   (redraw)
    
59.   (XD::End)
    
60.   ret
    
61. )

(defun XD::Doc:Getcorner (p msg clr xdir / con dynpt p1 p2 p4 pt ret v ydir)<br />   (defun callback (dynpt /)<br />     (setq pt (trans p 1 0)<br />           v (mapcar<br />               '-<br />               (setq p1 dynpt)<br />               pt<br />             )<br />           p2 (car (xd::pnts:orthoproject (list dynpt) pt (mapcar<br />                                                            '+<br />                                                            pt<br />                                                            xdir<br />                                                          )<br />                   )<br />              )<br />           p4 (car (xd::pnts:orthoproject (list dynpt) pt (mapcar<br />                                                            '+<br />                                                            pt<br />                                                            ydir<br />                                                          )<br />                   )<br />              )<br />     )<br />     (if (< (xdrx_point_dist2line dynpt pt p4) 0.0)<br />       (setq con 1)<br />       (setq con 0)<br />     )<br />     (redraw)<br />     (xdrx_grdraw clr con pt p2 dynpt p4 pt)<br />   )<br />   (if (not clr)<br />     (setq clr 1)<br />   )<br />   (setq clr (abs clr))<br /> <br />   (XD::Begin)<br />   (if (not xdir)<br />     (setq xdir (getvar "ucsxdir")<br />           ydir (getvar "ucsydir")<br />     )<br />     (progn<br />       (setq ydir (xdrx_vector_crossproduct (getvar "viewdir") xdir))<br />       (if (equal ydir '(0 0 0) 1e-3)<br />          (setq ydir (xdrx_vector_perpvector xdir))<br />       )<br />     )<br />   )<br />   (xdrx_pointmonitor "Callback" (xdrx_object_get "layer" "0"))<br />   (if (setq ret (getpoint msg))<br />     (setq ret (list (if (= con 0)<br />                       "WP"<br />                       "CP"<br />                     ) (xd::pnts:wcs2ucs (list pt p2 p1 p4))<br />               )<br />     )<br />   )<br />   (xdrx_pointmonitor)<br />   (redraw)<br />   (XD::End)<br />   ret<br /> )

newer

2017.8.10日修改，加入方向向量的控制。在当前UCS下，也可以指定一个特定的方向作为矩形框底边的方向。