请帮忙测试，修改填充比例或角度，64位win7，cad2008可用，求再优化

wjnnan

2. ;参考了明经论坛ucuc2003和Gu_xl的源码
   
3. ;修改填充图案比例
   
4. (defun C:gtb (/ hpsc ss name ent old_hatchbl new_hatchbl n )
   
5.    (setvar "cmdecho" 0)
   
6.    (setq hpsc (getvar "hpscale"))
   
7.    (command "_.undo" "_begin")
   
8.    (princ "\n请选择需要改变比例的填充图案")
   
9.    (setq ss (ssget '((0 . "hatch"))) )     
   
10.    (setq name (ssname ss 0))
    
11.    (setq ent (entget  name))
    
12.    (setq old_hatchbl (cdr (assoc 41 ent)))  
    
13.    (setq n 0) ;序号的初值设为0      
    
14.    (princ (strcat "\n当前填充图案的比例:<"(rtos old_hatchbl 2 2 )">"))
    
15.    (setq new_hatchbl (getdist "\n请输入新的填充比例"))
    
16.    (if (= new_hatchbl nil) (setq new_hatchbl old_hatchbl))
    
17.    (repeat
    
18.      (sslength ss);重复执行ss的长度的次数，即对象的个数
    
19.      (setq name (ssname ss n));得到选择集内第n个对象的图元名      
    
20.      (vla-put-PatternScale (vlax-ename->vla-object name) new_hatchbl)   
    
21.      (setq n(1+ n));序号n的数量加1   
    
22.    );end repeat
    
23.    (command "_.undo" "_end")
    
24.    (setvar "hpscale" hpsc)
    
25.    (princ (strcat "\n填充比例已改为:<"(rtos new_hatchbl)"> "))
    
26.    (princ)
    
27. );end defun
    
28. 
    
29. 
    
30. ;修改填充图案角度
    
31. (defun C:gtj (/ oldhpang ss name ent old_hatchjd new_hatchjd n )
    
32.     (setvar "cmdecho" 0)
    
33.     (setq oldhpang (getvar "hpang"))
    
34.     (command "_.undo" "_begin")
    
35.     (princ "\n请选择需要改变角度的填充图案")
    
36.     (setq ss (ssget '((0 . "hatch"))) )   
    
37.     (setq name (ssname ss 0))
    
38.     (setq ent (entget name))
    
39.     (setq old_hatchjd (cdr (assoc 52 ent)))  
    
40.     (setq n 0) ;序号的初值设为0        
    
41.     (princ (strcat "\n当前填充图案的角度:<"(angtos old_hatchjd )">度"))
    
42.     (setq new_hatchjd  (getangle "\n请输入新的填充角度"))
    
43.     (if (= new_hatchjd nil) (setq new_hatchjd old_hatchjd))   
    
44.     (repeat
    
45.       (sslength ss);重复执行ss的长度的次数，即对象的个数
    
46.       (setq name (ssname ss n));得到选择集内第n个对象的图元名
    
47.       (vla-put-PatternAngle (vlax-ename->vla-object name) new_hatchjd)   
    
48.       (setq n(1+ n));序号n的数量加1
    
49.     );end repeat
    
50.     (command "_.undo" "_end")
    
51.     (setvar "hpang" oldhpang)
    
52.     (princ (strcat "\n填充角度已改为:<"(angtos new_hatchjd)">度 "))
    
53.     (princ)
    
54. );end defun
    

;参考了明经论坛ucuc2003和Gu_xl的源码<br /> ;修改填充图案比例<br /> (defun C:gtb (/ hpsc ss name ent old_hatchbl new_hatchbl n )<br />    (setvar "cmdecho" 0)<br />    (setq hpsc (getvar "hpscale"))<br />    (command "_.undo" "_begin")<br />    (princ "\n请选择需要改变比例的填充图案")<br />    (setq ss (ssget '((0 . "hatch"))) )     <br />    (setq name (ssname ss 0))<br />    (setq ent (entget  name))<br />    (setq old_hatchbl (cdr (assoc 41 ent)))  <br />    (setq n 0) ;序号的初值设为0      <br />    (princ (strcat "\n当前填充图案的比例:<"(rtos old_hatchbl 2 2 )">"))<br />    (setq new_hatchbl (getdist "\n请输入新的填充比例"))<br />    (if (= new_hatchbl nil) (setq new_hatchbl old_hatchbl)) <br />    (repeat <br />      (sslength ss);重复执行ss的长度的次数，即对象的个数<br />      (setq name (ssname ss n));得到选择集内第n个对象的图元名      <br />      (vla-put-PatternScale (vlax-ename->vla-object name) new_hatchbl)   <br />      (setq n(1+ n));序号n的数量加1    <br />    );end repeat<br />    (command "_.undo" "_end")<br />    (setvar "hpscale" hpsc)<br />    (princ (strcat "\n填充比例已改为:<"(rtos new_hatchbl)"> ")) <br />    (princ)<br /> );end defun<br /> <br /> <br /> ;修改填充图案角度<br /> (defun C:gtj (/ oldhpang ss name ent old_hatchjd new_hatchjd n )<br />     (setvar "cmdecho" 0)<br />     (setq oldhpang (getvar "hpang"))<br />     (command "_.undo" "_begin")<br />     (princ "\n请选择需要改变角度的填充图案")<br />     (setq ss (ssget '((0 . "hatch"))) )   <br />     (setq name (ssname ss 0))<br />     (setq ent (entget name))<br />     (setq old_hatchjd (cdr (assoc 52 ent)))  <br />     (setq n 0) ;序号的初值设为0        <br />     (princ (strcat "\n当前填充图案的角度:<"(angtos old_hatchjd )">度"))<br />     (setq new_hatchjd  (getangle "\n请输入新的填充角度"))<br />     (if (= new_hatchjd nil) (setq new_hatchjd old_hatchjd))   <br />     (repeat <br />       (sslength ss);重复执行ss的长度的次数，即对象的个数<br />       (setq name (ssname ss n));得到选择集内第n个对象的图元名<br />       (vla-put-PatternAngle (vlax-ename->vla-object name) new_hatchjd)   <br />       (setq n(1+ n));序号n的数量加1<br />     );end repeat<br />     (command "_.undo" "_end")<br />     (setvar "hpang" oldhpang)<br />     (princ (strcat "\n填充角度已改为:<"(angtos new_hatchjd)">度 "))<br />     (princ)<br /> );end defun<br />