如何拉伸填充图案，有相关的Lisp工具吗？

cq4920

2. (defun C:sw (/ pt1 pt2 sg i s1)
   
3.   (princ "\n请选择拉伸对象（填充有边界会再次生成边界）：")
   
4.         (setq PT1 (getpoint "\n选择对象:"))
   
5.   (setq PT2 (getcorner PT1 " >>>第二点:"))
   
6.         ;；(setq ent (entlast))
   
7.   (setq sg (ssget "c" PT1 PT2 '((0 . "HATCH")) ) i -1);过滤对象只选填充图案
   
8.   (while (setq s1 (ssname sg (setq i (1+ i))));批量生成填充边界
   
9.     (command "-hatchedit" s1 "b" "p" "y")
   
10.    )
    
11.         (command  ".STRETCH" (ssget "c" PT1 PT2) "" pause pause);拉伸选择对象，可以修改只拉伸填充图案
    
12.         ;(COMMAND "_.erase"  (last_ent ent) "");本打算删除最后的边界图元，可惜不成功！
    
13.   (princ)
    
14. )
    

(defun C:sw (/ pt1 pt2 sg i s1) <br />   (princ "\n请选择拉伸对象（填充有边界会再次生成边界）：")<br />         (setq PT1 (getpoint "\n选择对象:"))<br />   (setq PT2 (getcorner PT1 " >>>第二点:"))<br />         ;；(setq ent (entlast))<br />   (setq sg (ssget "c" PT1 PT2 '((0 . "HATCH")) ) i -1);过滤对象只选填充图案<br />   (while (setq s1 (ssname sg (setq i (1+ i))));批量生成填充边界<br />     (command "-hatchedit" s1 "b" "p" "y")<br />    )<br />         (command  ".STRETCH" (ssget "c" PT1 PT2) "" pause pause);拉伸选择对象，可以修改只拉伸填充图案<br />         ;(COMMAND "_.erase"  (last_ent ent) "");本打算删除最后的边界图元，可惜不成功！<br />   (princ)<br /> )<br />

陈伟

填充图案拉伸小插件：http://bbs.mjtd.com/thread-181607-1-1.html


可以直接代替CAD原拉伸S命令！！