各位好：

          想求一程序，就是在CAD里面任意框选一下，图框就跟着出来了，大小就和
框选的一样，图框也是事先做好的，这样就不用老是缩放图框，提高效率，谢谢！


网友答: 本帖最后由 Gu_xl 于 2011-1-28 18:54 编辑

回复 cj52000 的帖子

  1. ;;;(tk 图块名) 2010.12.14 By Gu_xl
  2. (defun tk(tkname p1 p2 /  pp1 pp2 v h v1 h1 xscale yscale)
  3.   
  4.   (setq pp1 (mapcar '(lambda (x)(apply 'min x))  (apply 'mapcar (cons 'list (list p1 p2))))
  5.         pp2 (mapcar '(lambda (x)(apply 'max x))  (apply 'mapcar (cons 'list (list p1 p2))))
  6.         v (- (cadr pp2) (cadr pp1))
  7.         h (- (car pp2) (car pp1))
  8.         )
  9.   (if (> h v)
  10.       (setq v (/ h (/ 420. 297.)))
  11.       (setq h (/ v  (/ 420. 297.)))
  12.       )
  13.   (command "insert" tkname pp1 1 1 0)
  14.   (setq en (entlast))
  15.   (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
  16.   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
  17.   (setq p1 (vlax-safearray->list p1)
  18.         p2 (vlax-safearray->list p2)
  19.         v1 (- (cadr p2) (cadr p1))
  20.         h1 (- (car p2) (car p1))
  21.         )
  22.   (cond ((and (> h v) (>= h1 v1))
  23.           (setq        xscale (/ h h1)
  24.                 yscale (/ v v1)
  25.                 rot 0
  26.           )
  27.         )
  28.         ((and (> h v) (>= v1 h1))
  29.           (setq        yscale (/ h v1)
  30.                 xscale (/ v h1)
  31.                 rot -90
  32.           )
  33.         )
  34.         ((and (> v h) (>= v1 h1))
  35.           (setq        xscale (/ v v1)
  36.                 yscale (/ h h1)
  37.                 rot 0
  38.           )
  39.         )
  40.         ((and (> v h) (>= h1 v1))
  41.           (setq        yscale (/ v h1)
  42.                 xscale (/ h v1)
  43.                 rot 90
  44.           )
  45.         )
  46.         )
  47.   (entdel en)
  48.   (command "insert" tkname pp1 xscale yscale rot)
  49.   (setq en (entlast))
  50.     (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
  51.   (setq pl (mapcar 'vlax-safearray->list (list p1 p2)))
  52.   (setq p1 (vlax-safearray->list p1)
  53. p2 (vlax-safearray->list p2)
  54. )
  55.   (command "move" en "" p1 pp1)
  56.   (setq obj (vlax-ename->vla-object en))
  57.   (if (= :vlax-true (vla-get-HasAttributes obj))
  58.     (command "eattedit" en)
  59.     )
  60. (princ)
  61.   )
  62. ;;;测试
  63. (defun c:tk()
  64.   (setq oldcmdecho (getvar "cmdecho"))
  65.   (setq attreq (getvar "attreq"))
  66.   (setvar "cmdecho" 0)
  67.   (setvar "attreq" 0)
  68.   (setq blkname (getstring "\n输入要插入的图框名称："))
  69.   (while (and (setq p1 (getpoint "\n插入图框角点："))
  70.               (setq p2 (GETCORNER p1 "图框另一角点")
  71.               )
  72.          )
  73.   (tk blkname p1 p2)
  74.     )
  75.   (setvar "cmdecho" oldcmdecho)
  76.   (setvar "attreq" attreq)
  77.   (princ)
  78.   )


网友答: 回复 bai2000 的帖子

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

网友答:
Gu_xl 发表于 2010-12-14 12:33
回复 ljttjl 的帖子

这么简单的程序你也要编译发上来么？

版主，插入图框角点：图框另一角点; 错误: no function definition: VLAX-ENAME->VLA-OBJECT
这个是怎么回事 啊

网友答: 标准图框是什么样子的，发个dwg图形例子看看。

网友答: 这很简单啊！任意框选得到框选的长宽尺寸，根据要插入图框的固定图框尺寸，计算插入图块的X Y方向比例尺，插入图块即可！这么简单的程序楼主自己应该能够写出来吧！

网友答: 本帖最后由 xiaxiang 于 2010-12-13 15:15 编辑

这个应该比较简单，代码一时找不到，先发效果图



网友答: 回复 ljttjl 的帖子

回ljttjl兄，标准图框已上传，请查看附件！谢谢！

网友答: 回复 Gu_xl 的帖子

惭愧啊，对LISP略懂皮毛，见笑了！

网友答: 回复 xiaxiang 的帖子

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

网友答: 本帖最后由 ljttjl 于 2010-12-14 01:04 编辑

框选自动调出图框程序


此程序演示如下：




网友答: 本帖最后由 bai2000 于 2010-12-14 21:15 编辑

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

网友答: 回复 ljttjl 的帖子

回ljttjl兄，如果我换了一个图框，是不是直接替换掉现在标准图框DWG？谢谢！
  • 上一篇：更新：分享图块替换程序，支持保留原图块的缩
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025