[试用]：蝴蝶形状游标函数

fylinwater

蝴蝶形状游标函数
可以作为动态显示的标记

2. 
   
3. ;;-------------------------------------------------
   
4. ;;#$help.begin
   
5. ;;##function.name->  dd_movingyard3
   
6. ;;##keyword-> movingyard 游码 标记
   
7. ;;##Description-> 显示游码标记 边界为蝴蝶形
   
8. ;;##Arguments.begin
   
9. ;|  pt   <point>     游码点
   
10.     size <real>  游码相对屏幕的大小比例 (0<size<1)
    
11.     alp  <angle> 蝴蝶翅角度
    
12.     shap <real>  蝴蝶腰的粗细      |;
    
13. ;;##Arguments.end
    
14. ;;##return->   
    
15. ;;##examples.begin
    
16. ;|  (dd_movingyard3  (getpoint) 0.1  0.785 0.55)      |;
    
17. ;;##examples.end
    
18. ;;##see also->
    
19. ;;#$help.end
    
20. ;;-------------------------------------------------
    
21. 
    
22. ;;##use function->
    
23. ;;##use ddsysvar->
    
24. (defun  dd_movingyard3 ( pt size  alp shap / h1 h h2 i n alphan alph  )
    
25. (if (and (= 'LIST   (type pt)) (= 'REAL (type SIZE)) (= 'REAL (type alp)) (= 'REAL (type shap)))
    
26.       
    
27.     (progn
    
28.      (if (or (> size 1) (<=  size 0.0)) (setq size 0.05))
    
29.        ;;(setq alp 0.785)
    
30.      ;;(setq shap 0.55)
    
31.      (SETQ h1 (* size (getvar "viewsize") 0.5 ))
    
32.      (setq h2 (- 0 h1))
    
33.      (setq n (fix (* size 250)))
    
34.      (setq i 1)
    
35.      (setq alphan (/ alp n ))
    
36.      (setq n (-  (* 2 n)  1 ))
    
37. 
    
38.      (repeat n
    
39.         (setq alph (- alp (* alphan  i)))
    
40.         (if (> alph 0)
    
41.            (setq h (- h1 (* (- 1 alph) shap h1)))
    
42.           (setq h (- h1 (* (+ 1 alph) shap h1)))
    
43.         )
    
44.         (setq h2 (- 0 h))     
    
45.         (grdraw   (polar pt alph h ) (polar pt alph h2 ) 50  )
    
46.         (setq i (1+ i))
    
47.      )
    
48.      (grdraw   (polar pt alp h ) (polar pt alp h2 ) 5  )
    
49.      (grdraw   (polar pt 0 (* h1 (- 1 shap) )) (polar pt 0 (* h2 (- 1 shap) )) 2  )
    
50.      (grdraw   (polar pt (- 0 alp ) h ) (polar pt (- 0 alp ) h2 ) 5  )
    
51.     )
    
52.    )
    
53. 
    
54. (princ)
    
55. )
    
56. 
    

<br /> ;;-------------------------------------------------<br /> ;;#$help.begin<br /> ;;##function.name->  dd_movingyard3 <br /> ;;##keyword-> movingyard 游码 标记<br /> ;;##Description-> 显示游码标记 边界为蝴蝶形<br /> ;;##Arguments.begin<br /> ;|  pt   <point>     游码点 <br />     size <real>  游码相对屏幕的大小比例 (0<size<1)<br />     alp  <angle> 蝴蝶翅角度<br />     shap <real>  蝴蝶腰的粗细      |;<br /> ;;##Arguments.end<br /> ;;##return->   <br /> ;;##examples.begin<br /> ;|  (dd_movingyard3  (getpoint) 0.1  0.785 0.55)      |;<br /> ;;##examples.end<br /> ;;##see also-><br /> ;;#$help.end<br /> ;;-------------------------------------------------<br /> <br /> ;;##use function-><br /> ;;##use ddsysvar-><br /> (defun  dd_movingyard3 ( pt size  alp shap / h1 h h2 i n alphan alph  )<br /> (if (and (= 'LIST   (type pt)) (= 'REAL (type SIZE)) (= 'REAL (type alp)) (= 'REAL (type shap)))<br />       <br />     (progn<br />      (if (or (> size 1) (<=  size 0.0)) (setq size 0.05))<br />        ;;(setq alp 0.785)<br />      ;;(setq shap 0.55)<br />      (SETQ h1 (* size (getvar "viewsize") 0.5 ))<br />      (setq h2 (- 0 h1))<br />      (setq n (fix (* size 250)))<br />      (setq i 1)<br />      (setq alphan (/ alp n ))<br />      (setq n (-  (* 2 n)  1 ))<br /> <br />      (repeat n <br />         (setq alph (- alp (* alphan  i)))<br />         (if (> alph 0)<br />            (setq h (- h1 (* (- 1 alph) shap h1)))<br />           (setq h (- h1 (* (+ 1 alph) shap h1)))<br />         )<br />         (setq h2 (- 0 h))     <br />         (grdraw   (polar pt alph h ) (polar pt alph h2 ) 50  )<br />         (setq i (1+ i))<br />      )<br />      (grdraw   (polar pt alp h ) (polar pt alp h2 ) 5  )<br />      (grdraw   (polar pt 0 (* h1 (- 1 shap) )) (polar pt 0 (* h2 (- 1 shap) )) 2  )<br />      (grdraw   (polar pt (- 0 alp ) h ) (polar pt (- 0 alp ) h2 ) 5  )<br />     )<br />    )<br /> <br /> (princ)<br /> )<br /> <br />

Qlin

有创意

efan2000

原来在CAD中用Lisp也可以做出这么漂亮的图标。

loe0927

用什么命令起用呢

ss1025

不明白这个游标是做什么用的，楼主讲解一下吧

雨箭风刀

可以考虑搞个自定义游标

xyp1964

xyp-put-Mark：

2. [FONT=courier new];;;曲线顶点处作标记
   
3. (defun c:test ()
   
4.   (CMDLA0)
   
5.   (setq        ss (ssget '((0 . "*LINE")))
   
6.         i  -1
   
7.   )
   
8.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
9.     (setq ptn (xyp-get-Vertexs s1 0))
   
10.     (foreach pt        ptn
    
11.       (xyp-put-Mark pt 0)
    
12.     )
    
13.   )
    
14.   (CMDLA1)
    
15. )[/FONT]

[FONT=courier new];;;曲线顶点处作标记<br /> (defun c:test ()<br />   (CMDLA0)<br />   (setq        ss (ssget '((0 . "*LINE")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq ptn (xyp-get-Vertexs s1 0))<br />     (foreach pt        ptn<br />       (xyp-put-Mark pt 0)<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

dwg001

xyp真高，别人有新创意你马上能跟上。
你的新东东能否在别人之前发表？能力太强了，向你学习。

xyp1964

最初由 dwg001 发布
[B]xyp真高，别人有新创意你马上能跟上。
你的新东东能否在别人之前发表？能力太强了，向你学习。 [/B]

这是相互学习的过程，只要有好的东西都可以借鉴，你又不是天才！
再者2002年11月14日的东东也早就不是什么“新创意”了！

liu0060585

太有意思了，想不到在cad中也可以作出这么漂亮的图案啊。

xyp1964

ddbj(顶点标记)