(XD::Drag:Arc1)三点圆弧拖动实现函数

Lispboy

1. ;|
   
2. 三点圆弧拖动实现函数
   
3. 参数：
   
4.    info ---- 提示字符串
   
5.   pj  ---- 起点
   
6.   p2  ---- 弧上第二点
   
7.   keyWord ---  关键字字符串
   
8.   Cursor     --- 光标样式
   
9. 
   
10.             0 - kCrosshair
    
11.             1 - kCrosshair
    
12.             2 - kRubberBand
    
13.             3 - kNoSpecialCursor
    
14.             4 - kEntitySelect
    
15.             5 - kParallelogram
    
16.             6 - kInvisible
    
17.             其他值- kPkfirstOrGrips
    
18. 
    
19. 
    
20. |;
    
21. (defun XD::Drag:Arc1 (info pj p2 keyWord cursor / dynpt e mat0 pts ret)
    
22.   (defun EdgeCallBack (dynPt / pts)
    
23.     (setq arcinfo (xdrx_geom_3p2arc pj p2 dynpt))
    
24.     (if (not e)
    
25.       (setq e (apply
    
26.                 'xdrx_arc_make
    
27.                 (cdr arcinfo)
    
28.               )
    
29.       )
    
30.       (progn
    
31.         (xdrx_modent 10 (cadr arcinfo) 40 (nth 2 arcinfo) 50 (nth 3 arcinfo) 51 (nth 4 arcinfo))
    
32.       )
    
33.     )
    
34.     e
    
35.   )
    
36. 
    
37.   (setq pj (trans pj 1 0))
    
38.   (initget 1)
    
39.   (setq ret (xdrx_drag_jig "EdgeCallBack" info keyWord (+ 1 2 4 8 16 128 512 65536) Cursor pj))
    
40.   (cond
    
41.     ((= ret -4)
    
42.       (entdel (entlast))
    
43.     )
    
44.     (t
    
45.       (if (= (type ret) 'STR)
    
46.         (progn
    
47.          
    
48.           (entdel (entlast))
    
49.         )
    
50.       )
    
51.     )
    
52.   )
    
53. 
    
54.   (gc)
    
55.   ret
    
56. )
    
57. 
    

;|<br /> 三点圆弧拖动实现函数<br /> 参数：<br />    info ---- 提示字符串<br />   pj  ---- 起点<br />   p2  ---- 弧上第二点<br />   keyWord ---  关键字字符串<br />   Cursor     --- 光标样式 <br /> <br />             0 - kCrosshair<br />             1 - kCrosshair<br />             2 - kRubberBand<br />             3 - kNoSpecialCursor<br />             4 - kEntitySelect<br />             5 - kParallelogram<br />             6 - kInvisible<br />             其他值- kPkfirstOrGrips<br /> <br /> <br /> |; <br /> (defun XD::Drag:Arc1 (info pj p2 keyWord cursor / dynpt e mat0 pts ret)<br />   (defun EdgeCallBack (dynPt / pts)<br />     (setq arcinfo (xdrx_geom_3p2arc pj p2 dynpt))<br />     (if (not e)<br />       (setq e (apply<br />                 'xdrx_arc_make<br />                 (cdr arcinfo)<br />               )<br />       )<br />       (progn<br />         (xdrx_modent 10 (cadr arcinfo) 40 (nth 2 arcinfo) 50 (nth 3 arcinfo) 51 (nth 4 arcinfo))<br />       )<br />     )<br />     e<br />   )<br /> <br />   (setq pj (trans pj 1 0))<br />   (initget 1)<br />   (setq ret (xdrx_drag_jig "EdgeCallBack" info keyWord (+ 1 2 4 8 16 128 512 65536) Cursor pj))<br />   (cond<br />     ((= ret -4)<br />       (entdel (entlast))<br />     )<br />     (t<br />       (if (= (type ret) 'STR)<br />         (progn<br />           <br />           (entdel (entlast))<br />         )<br />       )<br />     )<br />   )<br /> <br />   (gc)<br />   ret<br /> )<br /> <br />

测试示例代码：

1. (defun c:test-drag-arc1()
   
2.    (if (and (setq p1 (getpoint "\n起点:"))
   
3.             (setq p2 (getpoint "\n第二点:"))
   
4.        )
   
5.      (progn
   
6. 
   
7.         (XD::Drag:Arc1 "\n终点[退出-Q]:" p1 p2 "Q" 0)
   
8.      )
   
9.   )
   
10.   (princ)
    
11. )
    
12. 
    

(defun c:test-drag-arc1()<br />    (if (and (setq p1 (getpoint "\n起点:"))<br />             (setq p2 (getpoint "\n第二点:"))<br />        )<br />      (progn<br /> <br />         (XD::Drag:Arc1 "\n终点[退出-Q]:" p1 p2 "Q" 0)<br />      )<br />   )<br />   (princ)<br /> )<br /> <br />