（XD::Drag:PLine）动态拖动生成PLINE外框（支持起始结束宽度不同）

Lispboy

1. (defun XD::Drag:PLine (pt    info  swid         ewid  /     clr   dir         dynpt
   
2.                        msg   my_err         p1    p2    p3           p4         pts
   
3.                        vdir
   
4.                       )
   
5.   (defun my_err        (msg)
   
6.     (xdrx_prompt "\n" msg)
   
7.     (xdrx_pointmonitor)
   
8.     (redraw)
   
9.   )
   
10.   (defun _callback (dynpt)
    
11.     (redraw)
    
12.     (setq dir  (xdrx_vector_normalize
    
13.                  (mapcar
    
14.                    '-
    
15.                    dynpt
    
16.                    pt
    
17.                  )
    
18.                )
    
19.           vdir (xdrx_vector_perpvector dir)
    
20.           p1   (mapcar
    
21.                  '+
    
22.                  pt
    
23.                  (xdrx_vector_product vdir (- swid))
    
24.                )
    
25.           p2   (mapcar
    
26.                  '+
    
27.                  dynpt
    
28.                  (xdrx_vector_product vdir (- ewid))
    
29.                )
    
30.           p3   (mapcar
    
31.                  '+
    
32.                  dynpt
    
33.                  (xdrx_vector_product vdir ewid)
    
34.                )
    
35.           p4   (mapcar
    
36.                  '+
    
37.                  pt
    
38.                  (xdrx_vector_product vdir swid)
    
39.                )
    
40.           pts  (list p1 p2 p3 p4 p1)
    
41.     )
    
42.     (xdrx_grdraw clr 0 pts)
    
43.     pts
    
44.   )
    
45.   (setq *error* my_err)
    
46.   (xdrx_pointmonitor "_callback")
    
47.   (setq        pt   (trans pt 1 0)
    
48.         swid (* 0.5 swid)
    
49.         ewid (* 0.5 ewid)
    
50.         clr  (XD::DRAG:GETCOLOR)
    
51.   )
    
52.   (if (setq p1 (getpoint pt info))
    
53.     (progn
    
54.       p1
    
55.     )
    
56.   )
    
57.   (xdrx_pointmonitor)
    
58.   (setq *error* nil)
    
59.   pts
    
60. )
    

(defun XD::Drag:PLine (pt    info  swid         ewid  /     clr   dir         dynpt<br />                        msg   my_err         p1    p2    p3           p4         pts<br />                        vdir<br />                       )<br />   (defun my_err        (msg)<br />     (xdrx_prompt "\n" msg)<br />     (xdrx_pointmonitor)<br />     (redraw)<br />   )<br />   (defun _callback (dynpt)<br />     (redraw)<br />     (setq dir  (xdrx_vector_normalize<br />                  (mapcar<br />                    '-<br />                    dynpt<br />                    pt<br />                  )<br />                )<br />           vdir (xdrx_vector_perpvector dir)<br />           p1   (mapcar<br />                  '+<br />                  pt<br />                  (xdrx_vector_product vdir (- swid))<br />                )<br />           p2   (mapcar<br />                  '+<br />                  dynpt<br />                  (xdrx_vector_product vdir (- ewid))<br />                )<br />           p3   (mapcar<br />                  '+<br />                  dynpt<br />                  (xdrx_vector_product vdir ewid)<br />                )<br />           p4   (mapcar<br />                  '+<br />                  pt<br />                  (xdrx_vector_product vdir swid)<br />                )<br />           pts  (list p1 p2 p3 p4 p1)<br />     )<br />     (xdrx_grdraw clr 0 pts)<br />     pts<br />   )<br />   (setq *error* my_err)<br />   (xdrx_pointmonitor "_callback")<br />   (setq        pt   (trans pt 1 0)<br />         swid (* 0.5 swid)<br />         ewid (* 0.5 ewid)<br />         clr  (XD::DRAG:GETCOLOR)<br />   )<br />   (if (setq p1 (getpoint pt info))<br />     (progn<br />       p1<br />     )<br />   )<br />   (xdrx_pointmonitor)<br />   (setq *error* nil)<br />   pts<br /> )<br />