[LISP函数]：修改Hatch比例

eachy

2. 
   
3. ;;
   
4. ;;今天在一张规划图（别人绘制的）上画图，图中的填充非常密实，搞的PIII933+256M+TNT2(36M)跑起来都吃力，
   
5. ;;系统资源被占用绝大部分，临时写了个程序修改填充比例，For 2000+
   
6. ;;非solid填充在非常密的情况下，尽量用单选的方式
   
7. ;;
   
8. (defun c:hatscl        (/ kw tf en scl ss e oldscl)
   
9.   ;;(ea:begin '("osmode"))
   
10.   (initget "1 2")
    
11.   (setq kw (getkword "\n[1 - 匹配 / 2 - 变比]<2>: "))
    
12.   (if (or (not kw) (= kw ""))
    
13.     (setq kw "2")
    
14.   )
    
15.   (if (= kw "1")
    
16.     (progn
    
17.       (setq tf t)
    
18.       (while tf
    
19.         (setq en (entsel "\n选择填充: "))
    
20.         (if en
    
21.           (cond
    
22.             ((=        (vla-get-objectname (vlax-ename->vla-object (car en)))
    
23.                 "AcDbHatch"
    
24.              )
    
25.              (setq tf nil)
    
26.             )
    
27.             (t (princ "\n选择为非填充实体! 重新选择..."))
    
28.           )
    
29.         )
    
30.       )
    
31.       (setq scl        (vla-get-patternscale
    
32.                   (vlax-ename->vla-object (car en))
    
33.                 )
    
34.       )
    
35.     )
    
36.     (setq scl (getreal "\n缩放比例: "))
    
37.   )
    
38.   (princ "\n选择范围....")
    
39.   (setq ss (ssget '((0 . "hatch"))))
    
40.   (if ss
    
41.     (progn
    
42.       (setq n 0)
    
43.       (repeat (sslength ss)
    
44.         (setq e (vlax-ename->vla-object (ssname ss n)))
    
45.         (setq oldscl (vla-get-patternscale e))
    
46.         (vla-put-patternscale
    
47.           e
    
48.           (if (= kw "1")
    
49.             scl
    
50.             (* scl oldscl)
    
51.           )
    
52.         )
    
53.         (setq n (1+ n))
    
54.       )
    
55.     )
    
56.   )
    
57. ;(ea:end)
    
58.   (princ)
    
59. )

<br /> ;;<br /> ;;今天在一张规划图（别人绘制的）上画图，图中的填充非常密实，搞的PIII933+256M+TNT2(36M)跑起来都吃力，<br /> ;;系统资源被占用绝大部分，临时写了个程序修改填充比例，For 2000+<br /> ;;非solid填充在非常密的情况下，尽量用单选的方式<br /> ;;<br /> (defun c:hatscl        (/ kw tf en scl ss e oldscl)<br />   ;;(ea:begin '("osmode"))<br />   (initget "1 2")<br />   (setq kw (getkword "\n[1 - 匹配 / 2 - 变比]<2>: "))<br />   (if (or (not kw) (= kw ""))<br />     (setq kw "2")<br />   )<br />   (if (= kw "1")<br />     (progn<br />       (setq tf t)<br />       (while tf<br />         (setq en (entsel "\n选择填充: "))<br />         (if en<br />           (cond<br />             ((=        (vla-get-objectname (vlax-ename->vla-object (car en)))<br />                 "AcDbHatch"<br />              )<br />              (setq tf nil)<br />             )<br />             (t (princ "\n选择为非填充实体! 重新选择..."))<br />           )<br />         )<br />       )<br />       (setq scl        (vla-get-patternscale<br />                   (vlax-ename->vla-object (car en))<br />                 )<br />       )<br />     )<br />     (setq scl (getreal "\n缩放比例: "))<br />   )<br />   (princ "\n选择范围....")<br />   (setq ss (ssget '((0 . "hatch"))))<br />   (if ss<br />     (progn<br />       (setq n 0)<br />       (repeat (sslength ss)<br />         (setq e (vlax-ename->vla-object (ssname ss n)))<br />         (setq oldscl (vla-get-patternscale e))<br />         (vla-put-patternscale<br />           e<br />           (if (= kw "1")<br />             scl<br />             (* scl oldscl)<br />           )<br />         )<br />         (setq n (1+ n))<br />       )<br />     )<br />   )<br /> ;(ea:end)<br />   (princ)<br /> )

xxxyzxx

恩，单选确实是好办法，如果不能单选，需要区域选择或者多选的时候如何处理呢？请略为详尽说明！

江南.菜鸟

郁闷，我自己改不来

eachy

改完了刷一下

ScmTools

很好的程序