cj52000 发表于 2010-12-12 17:15:39

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

各位好：

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

Gu_xl 发表于 2011-1-28 18:44:33

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

回复 cj52000 的帖子


;;;(tk 图块名) 2010.12.14 By Gu_xl
(defun tk(tkname p1 p2 /pp1 pp2 v h v1 h1 xscale yscale)

(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))
      )
(if (> h v)
      (setq v (/ h (/ 420. 297.)))
      (setq h (/ v(/ 420. 297.)))
      )
(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))
      )
(cond ((and (> h v) (>= h1 v1))
          (setq      xscale (/ h h1)
                yscale (/ v v1)
                rot 0
          )
      )
      ((and (> h v) (>= v1 h1))
          (setq      yscale (/ h v1)
                xscale (/ v h1)
                rot -90
          )
      )
      ((and (> v h) (>= v1 h1))
          (setq      xscale (/ v v1)
                yscale (/ h h1)
                rot 0
          )
      )
      ((and (> v h) (>= h1 v1))
          (setq      yscale (/ v h1)
                xscale (/ h v1)
                rot 90
          )
      )
      )
(entdel en)
(command "insert" tkname pp1 xscale yscale rot)
(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)
(setq obj (vlax-ename->vla-object en))
(if (= :vlax-true (vla-get-HasAttributes obj))
    (command "eattedit" en)
    )
(princ)
)
;;;测试
(defun c:tk()
(setq oldcmdecho (getvar "cmdecho"))
(setq attreq (getvar "attreq"))
(setvar "cmdecho" 0)
(setvar "attreq" 0)
(setq blkname (getstring "\n输入要插入的图框名称："))
(while (and (setq p1 (getpoint "\n插入图框角点："))
            (setq p2 (GETCORNER p1 "图框另一角点")
            )
         )
(tk blkname p1 p2)
    )
(setvar "cmdecho" oldcmdecho)
(setvar "attreq" attreq)
(princ)
)

Gu_xl 发表于 2010-12-14 22:08:09

回复 bai2000 的帖子

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

leedun 发表于 2023-12-15 20:09:20

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

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


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

ljttjl 发表于 2010-12-12 22:13:08

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

Gu_xl 发表于 2010-12-12 23:16:45

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

xiaxiang 发表于 2010-12-13 15:13:57

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

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

cj52000 发表于 2010-12-13 15:15:14

回复 ljttjl 的帖子

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

cj52000 发表于 2010-12-13 15:17:15

回复 Gu_xl 的帖子

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

cj52000 发表于 2010-12-13 16:42:22

回复 xiaxiang 的帖子

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

ljttjl 发表于 2010-12-14 00:56:38

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

框选自动调出图框程序


此程序演示如下：


bai2000 发表于 2010-12-14 02:05:03

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

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

cj52000 发表于 2010-12-14 10:47:56

回复 ljttjl 的帖子

回ljttjl兄，如果我换了一个图框，是不是直接替换掉现在标准图框DWG？谢谢！
页: [1] 2 3 4 5 6 7
查看完整版本: 求框选自动调出图框的程序？