求框选自动调出图框的程序？

Gu_xl

回复 ljttjl 的帖子

这么简单的程序你也要编译发上来么？
花了几分钟，写了段代码，供大家修改使用

2. 
   
3. 
   
4. ;;;(tk 图块名) 2010.12.14 By Gu_xl
   
5. (defun tk(tkname /  p1 p2 pp1 pp2 v h v1 h1 xscale yscale)
   
6.   (setq p1 (getpoint "\n插入图框角点：")
   
7.         p2 (GETCORNER p1 "图框另一角点")
   
8.         )
   
9.   (setq pp1 (mapcar '(lambda (x)(apply 'min x))  (apply 'mapcar (cons 'list (list p1 p2))))
   
10.         pp2 (mapcar '(lambda (x)(apply 'max x))  (apply 'mapcar (cons 'list (list p1 p2))))
    
11.         v (- (cadr pp2) (cadr pp1))
    
12.         h (- (car pp2) (car pp1))
    
13.         )
    
14.   (command "insert" tkname pp1 1 1 0)
    
15.   (setq en (entlast))
    
16.   (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
    
17.   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
    
18.   (setq p1 (vlax-safearray->list p1)
    
19.         p2 (vlax-safearray->list p2)
    
20.         v1 (- (cadr p2) (cadr p1))
    
21.         h1 (- (car p2) (car p1))
    
22.         )
    
23.   (setq xscale (/ h h1)
    
24.         yscale (/ v v1)
    
25.         )
    
26.   (entdel en)
    
27.   (command "insert" tkname pp1 xscale yscale 0)
    
28.   (setq en (entlast))
    
29.     (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
    
30.   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
    
31.   (setq p1 (vlax-safearray->list p1)
    
32. p2 (vlax-safearray->list p2)
    
33. )
    
34.   (command "move" en "" p1 pp1)
    
35. 
    
36. (princ)
    
37.   )
    
38. ;;;测试
    
39. (defun c:tk()
    
40.   (setq oldcmdecho (getvar "cmdecho"))
    
41.   (setvar "cmdecho" 0)
    
42.   (setq blkname (getstring "\n输入要插入的图框名称："))
    
43.   (tk blkname)
    
44.   (setvar "cmdecho" oldcmdecho)
    
45.   (princ)
    
46.   )
    

<br /> <br /> ;;;(tk 图块名) 2010.12.14 By Gu_xl<br /> (defun tk(tkname /  p1 p2 pp1 pp2 v h v1 h1 xscale yscale)<br />   (setq p1 (getpoint "\n插入图框角点：")<br />         p2 (GETCORNER p1 "图框另一角点")<br />         )<br />   (setq pp1 (mapcar '(lambda (x)(apply 'min x))  (apply 'mapcar (cons 'list (list p1 p2))))<br />         pp2 (mapcar '(lambda (x)(apply 'max x))  (apply 'mapcar (cons 'list (list p1 p2))))<br />         v (- (cadr pp2) (cadr pp1))<br />         h (- (car pp2) (car pp1))<br />         )<br />   (command "insert" tkname pp1 1 1 0)<br />   (setq en (entlast))<br />   (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)<br />   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))<br />   (setq p1 (vlax-safearray->list p1)<br />         p2 (vlax-safearray->list p2)<br />         v1 (- (cadr p2) (cadr p1))<br />         h1 (- (car p2) (car p1))<br />         )<br />   (setq xscale (/ h h1)<br />         yscale (/ v v1)<br />         )<br />   (entdel en)<br />   (command "insert" tkname pp1 xscale yscale 0)<br />   (setq en (entlast))<br />     (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)<br />   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))<br />   (setq p1 (vlax-safearray->list p1)<br /> p2 (vlax-safearray->list p2)<br /> )<br />   (command "move" en "" p1 pp1)<br /> <br /> (princ)<br />   )<br /> ;;;测试<br /> (defun c:tk()<br />   (setq oldcmdecho (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (setq blkname (getstring "\n输入要插入的图框名称："))<br />   (tk blkname)<br />   (setvar "cmdecho" oldcmdecho)<br />   (princ)<br />   )<br />

bai2000

Gu_xl
楼上大哥能不能改一下：1、可以连续插入？2、同时长宽的比例强制是图纸长宽（420/297）的比例？3、是副能实现完毕后自动弹出图框中属性对话框，以便填写：图名、图号、日期等

Gu_xl

回复 bai2000 的帖子

要连续插入，加个while循环即可，长宽的比例强制是图纸长宽（420/297）的比例，你可以根据X方向来强制Y方向，也可以根据y方向来强制X方向！至于弄对话框，是很麻烦的，因为图框里的属性不固定，需要动态自动生成对话框！简单起见，你可以在命令行里录入属性，根据我的提示，你自己可以慢慢尝试修改，来达到自己的需求，这样编程水平才会提高，不要总想着别人给你做好完美的代码给你！这里只是技术交流的地方！

xiaxiang

cj52000 发表于 2010-12-13 16:42
回复 xiaxiang 的帖子

兄弟，能否分享下你的程序啊！

需要安装，好不容易找到请下载试用

bai2000

俺是菜鸟，我的问题哪位能帮帮我改改？

狂刀lxx

强烈建议插入

jsdtzjm

看了就顶，谢谢

bai2000

还没人理我啊

xyp1964

Gu_xl

回复 bai2000 的帖子

插完图框后，紧接着使用如下语句即可弹出属性对话框！
(command "eattedit" (entlast))