[分享]： 畫拆線箭頭

taner

2. 
   
3.   [FONT=courier new]
   
4. (defun c:test (/ arrow lst pt pt1)
   
5.   (p-s '("osmode" 512
   
6.         "plinewid" 0
   
7.         "cmdecho" 0
   
8.        ) t
   
9.   )
   
10.   (setq arrow (vl-registry-read "HKEY_CURRENT_USER\\Software\\Autodesk\\THCAD"
    
11.                                 "arrow"
    
12.               )
    
13.   )
    
14.   (if arrow
    
15.     (setq arrow (ureal 7 "" "\n\t请输入箭头长度" (read arrow)))
    
16.     (setq arrow (ureal 7 "" "\n\t请输入箭头长度<--->" arrow))
    
17.   )
    
18.   (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\THCAD" "arrow"
    
19.                      (rtos arrow)
    
20.   )
    
21. 
    
22.   (command "pline")
    
23.   (while (setq pt (getpoint (if pt
    
24.                               pt
    
25.                               (list 0 0 0)
    
26.                             ) "\n\t請指定(折線)頂(端)點<回車退出>:"
    
27.                   )
    
28.          )
    
29.     (setq lst (cons pt lst))
    
30.     (command pt)
    
31.   )
    
32.   (command "")
    
33.   (setq pt1 (polar (car lst) (angle (cadr lst) (car lst)) arrow))
    
34.   (command "pline" (car lst) "w" (/ arrow 2.8) 0 pt1 "")
    
35.   (p-e)
    
36. )
    
37. 
    
38.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:test (/ arrow lst pt pt1)<br />   (p-s '("osmode" 512<br />         "plinewid" 0<br />         "cmdecho" 0<br />        ) t<br />   )<br />   (setq arrow (vl-registry-read "HKEY_CURRENT_USER\\Software\\Autodesk\\THCAD"<br />                                 "arrow"<br />               )<br />   )<br />   (if arrow<br />     (setq arrow (ureal 7 "" "\n\t请输入箭头长度" (read arrow)))<br />     (setq arrow (ureal 7 "" "\n\t请输入箭头长度<--->" arrow))<br />   )<br />   (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\THCAD" "arrow"<br />                      (rtos arrow)<br />   )<br /> <br />   (command "pline")<br />   (while (setq pt (getpoint (if pt<br />                               pt<br />                               (list 0 0 0)<br />                             ) "\n\t請指定(折線)頂(端)點<回車退出>:"<br />                   )<br />          )<br />     (setq lst (cons pt lst))<br />     (command pt)<br />   )<br />   (command "")<br />   (setq pt1 (polar (car lst) (angle (cadr lst) (car lst)) arrow))<br />   (command "pline" (car lst) "w" (/ arrow 2.8) 0 pt1 "")<br />   (p-e)<br /> )<br /> <br />   [/FONT]<br />