本帖最后由 Gu_xl 于 2010-12-14 12:46 编辑
回复 ljttjl 的帖子
这么简单的程序你也要编译发上来么？
花了几分钟，写了段代码，供大家修改使用
;;;(tk 图块名) 2010.12.14 By Gu_xl
(defun tk(tkname /p1 p2 pp1 pp2 v h v1 h1 xscale yscale)
(setq p1 (getpoint "\n插入图框角点：")
p2 (GETCORNER p1 "图框另一角点")
)
(setq pp1 (mapcar '(lambda (x)(apply 'min x))(apply 'mapcar (cons 'list (list p1 p2))))
pp2 (mapcar '(lambda (x)(apply 'max x))(apply 'mapcar (cons 'list (list p1 p2))))
v (- (cadr pp2) (cadr pp1))
h (- (car pp2) (car pp1))
)
(command "insert" tkname pp1 1 1 0)
(setq en (entlast))
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
v1 (- (cadr p2) (cadr p1))
h1 (- (car p2) (car p1))
)
(setq xscale (/ h h1)
yscale (/ v v1)
)
(entdel en)
(command "insert" tkname pp1 xscale yscale 0)
(setq en (entlast))
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(command "move" en "" p1 pp1)
(princ)
)
;;;测试
(defun c:tk()
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq blkname (getstring "\n输入要插入的图框名称："))
(tk blkname)
(setvar "cmdecho" oldcmdecho)
(princ)
)
Gu_xl
楼上大哥能不能改一下：1、可以连续插入？2、同时长宽的比例强制是图纸长宽（420/297）的比例？3、是副能实现完毕后自动弹出图框中属性对话框，以便填写：图名、图号、日期等
回复 bai2000 的帖子
要连续插入，加个while循环即可，长宽的比例强制是图纸长宽（420/297）的比例，你可以根据X方向来强制Y方向，也可以根据y方向来强制X方向！至于弄对话框，是很麻烦的，因为图框里的属性不固定，需要动态自动生成对话框！简单起见，你可以在命令行里录入属性，根据我的提示，你自己可以慢慢尝试修改，来达到自己的需求，这样编程水平才会提高，不要总想着别人给你做好完美的代码给你！这里只是技术交流的地方！
cj52000 发表于 2010-12-13 16:42 static/image/common/back.gif
回复 xiaxiang 的帖子
兄弟，能否分享下你的程序啊！
需要安装，好不容易找到请下载试用
俺是菜鸟，我的问题哪位能帮帮我改改？
强烈建议插入
看了就顶，谢谢
还没人理我啊
回复 bai2000 的帖子
插完图框后，紧接着使用如下语句即可弹出属性对话框！
(command "eattedit" (entlast))