[转帖]修改Hatch比例

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