[分享]：打造AUTOCAD 的宏命令

wkai

拜aidraft所赐的函数SendKeys，做几个调用文字修改大师的宏命令。觉得很有趣，请大家过目。

2. 
   
3.   [FONT=courier new]
   
4. ;;;;___________________________________________
   
5. ;;;;___________________________________________
   
6. ;;;;___________________________________________
   
7. (defun SendKeys        (keys / ws)
   
8.   (vl-load-com)
   
9.   (setq ws (vlax-create-object "WScript.Shell"))
   
10.   (vlax-invoke-method ws 'sendkeys keys)
    
11.   (vlax-release-object ws)
    
12.   (princ)
    
13. )
    
14. (defun ptos (e)
    
15.     (setq e (mapcar 'rtos e))
    
16.     (setq e (strcat (car e) "," (cadr e) "," (caddr e)))
    
17.   )
    
18. ;;;;___________________________________________
    
19. ;;;;___________________________________________
    
20. ;;;;___________________________________________
    
21. (defun c:tt();;文字替换
    
22.   (setq ss (ssget '((0 . "text"))))
    
23.   (command "._select" ss "")
    
24.   (setq str1 "77")
    
25.   (setq str2 "88")
    
26.   (sendkeys (strcat"ctt r   l " str1 " " str2 "  "))
    
27.   )
    
28. (defun c:tt();;文字打断
    
29.   (setq e (cadr (entsel)))
    
30.   (setq e (ptos  e))  
    
31.   (sendkeys (strcat"ctt n " e " " e "  "))
    
32.   )
    
33. (defun c:tt();;文字居中对齐
    
34.     (princ "\n选择文字:")
    
35.   (setq p1 (getpoint "\n角点1"))
    
36.   (setq p2 (getcorner p1 "\对角点:"))
    
37.   (setq p3 (getpoint  "\对齐点:"))
    
38.   (setq p1 (ptos p1) p2 (ptos p2) p3(ptos p3) )
    
39.   (sendkeys (strcat"ctt q " p1 " " p2 "  m c a c "p3"  "))
    
40.   )
    
41.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;;___________________________________________<br /> ;;;;___________________________________________<br /> ;;;;___________________________________________<br /> (defun SendKeys        (keys / ws)<br />   (vl-load-com)<br />   (setq ws (vlax-create-object "WScript.Shell"))<br />   (vlax-invoke-method ws 'sendkeys keys)<br />   (vlax-release-object ws)<br />   (princ)<br /> )<br /> (defun ptos (e)<br />     (setq e (mapcar 'rtos e))<br />     (setq e (strcat (car e) "," (cadr e) "," (caddr e)))<br />   )<br /> ;;;;___________________________________________<br /> ;;;;___________________________________________<br /> ;;;;___________________________________________<br /> (defun c:tt();;文字替换<br />   (setq ss (ssget '((0 . "text"))))<br />   (command "._select" ss "")<br />   (setq str1 "77")<br />   (setq str2 "88")<br />   (sendkeys (strcat"ctt r   l " str1 " " str2 "  "))<br />   )<br /> (defun c:tt();;文字打断<br />   (setq e (cadr (entsel)))<br />   (setq e (ptos  e))  <br />   (sendkeys (strcat"ctt n " e " " e "  "))<br />   )<br /> (defun c:tt();;文字居中对齐<br />     (princ "\n选择文字:")<br />   (setq p1 (getpoint "\n角点1"))<br />   (setq p2 (getcorner p1 "\对角点:"))<br />   (setq p3 (getpoint  "\对齐点:"))<br />   (setq p1 (ptos p1) p2 (ptos p2) p3(ptos p3) )<br />   (sendkeys (strcat"ctt q " p1 " " p2 "  m c a c "p3"  "))<br />   )<br />   [/FONT]<br />