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

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)
)

;;;(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？谢谢！

账号		自动登录	找回密码
密码			注册

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

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源