[LISP程序]：生成局部放大图的小工具

lsjjm

生成局部放大图的小工具：

2. 
   
3. (defun c:detail ( )
   
4.   (setvar "osmode" 0)
   
5.   (setq p1 (getpoint "\nDetail Center:"))
   
6.   (prompt "\nShow detail area: ")
   
7.   (command "_circle" p1 pause)
   
8.   (setq ent (entlast))
   
9.   (setq pc (cdr (assoc 10 (entget ent)))
   
10.          r (cdr (assoc 40 (entget ent))))
    
11.   (vl-cmdf "_polygon" 180 p1 "i" r)
    
12.   (setq pg (entlast))
    
13.   (setq el (entget pg))
    
14.   (while (setq tmp (assoc 10 el))
    
15.     (setq el (cdr (member tmp el))
    
16.          pts (cons (cdr tmp) pts))
    
17.   );w
    
18.   (entdel pg)
    
19.   (setq ss (ssget "cp" pts))
    
20.   (ssdel ent ss)
    
21.   (vl-cmdf "_copy" ss ent "" p1 p1)
    
22.   (setq p2 (getpoint p1 "\nPut Detail at:"))
    
23.   (vl-cmdf "_move" ss ent "" p1 p2)
    
24.   (setq s (getreal "\nInput Radio:<2>"))
    
25.   (if (null s)(setq s 2.0))
    
26.   (vl-cmdf "_scale" ss ent "" p2 s)
    
27.   (setq n 0)
    
28.   (while (< n (sslength ss))
    
29.     (setq ee (entget (ssname ss n))
    
30.              pt1 (cdr (assoc 10 ee))
    
31.              pt2 (cdr (assoc 11 ee)))
    
32.    (foreach i (list pt1 pt2)
    
33.       (if (> (distance i p2)(* r s))
    
34.         (vl-cmdf "_trim" ent "" (list (ssname ss n) i) "")
    
35.       )
    
36.     );f
    
37.     (setq n (1+ n))
    
38.   );w
    
39.   (vl-cmdf "text" (getpoint "\nInput Detail point:")(* (getvar "dimscale") 0.18) 0 "DETAIL A" "")
    
40.   (setvar "osmode" 37)
    
41.   (princ)
    
42. );defun

<br /> (defun c:detail ( )<br />   (setvar "osmode" 0)<br />   (setq p1 (getpoint "\nDetail Center:"))<br />   (prompt "\nShow detail area: ")<br />   (command "_circle" p1 pause)<br />   (setq ent (entlast))<br />   (setq pc (cdr (assoc 10 (entget ent)))<br />          r (cdr (assoc 40 (entget ent))))<br />   (vl-cmdf "_polygon" 180 p1 "i" r)<br />   (setq pg (entlast))<br />   (setq el (entget pg))<br />   (while (setq tmp (assoc 10 el))<br />     (setq el (cdr (member tmp el))<br />          pts (cons (cdr tmp) pts))<br />   );w<br />   (entdel pg)<br />   (setq ss (ssget "cp" pts))<br />   (ssdel ent ss)<br />   (vl-cmdf "_copy" ss ent "" p1 p1)<br />   (setq p2 (getpoint p1 "\nPut Detail at:"))<br />   (vl-cmdf "_move" ss ent "" p1 p2)<br />   (setq s (getreal "\nInput Radio:<2>"))<br />   (if (null s)(setq s 2.0))<br />   (vl-cmdf "_scale" ss ent "" p2 s)<br />   (setq n 0)<br />   (while (< n (sslength ss))<br />     (setq ee (entget (ssname ss n))<br />              pt1 (cdr (assoc 10 ee))<br />              pt2 (cdr (assoc 11 ee))) <br />    (foreach i (list pt1 pt2)<br />       (if (> (distance i p2)(* r s))<br />         (vl-cmdf "_trim" ent "" (list (ssname ss n) i) "")<br />       )<br />     );f<br />     (setq n (1+ n))<br />   );w<br />   (vl-cmdf "text" (getpoint "\nInput Detail point:")(* (getvar "dimscale") 0.18) 0 "DETAIL A" "")<br />   (setvar "osmode" 37)<br />   (princ)<br /> );defun

lijiao

这是运行提示

lijiao

我这个如何？

light_dream

lijiao,你的这个是个好东西，可以给大家共享一下吗？我没有用ACAD2002或ACAD2004，不知是不是高版本的特殊功能？

acy2000

不知怎么回事，我用怎么不好用。我用的pcad2004

lijiao

最初由 light_dream 发布
[B]lijiao,你的这个是个好东西，可以给大家共享一下吗？我没有用ACAD2002或ACAD2004，不知是不是高版本的特殊功能？ [/B]

这是我自己做的小程序。

panzhongw

能介绍一下思路吗？

lijiao

第3贴中应该能够看出思路来吧。

libo2000

不错

davide888

又学了个vl-cmdf

金鹅起飞

个人觉得不好用，但也谢谢楼主分享源码，谢谢！

sdjinghua0803

赞一个，支持楼主，顶一下！

weiyao586

不错，不错！

scnjlwb

提示参数类型错误，什么原因。

fangseng

可惜的是，尺寸也随放大尺寸变化！