不打开图形，从外部DWG拷贝一个块定义到当前图形

marting · 发表于 2017-5-25 21:08:38

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun copy-blk (dwg blk / blkdbx catch odbx)
(if (findfile dwg)
(progn
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq odbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq odbx (vlax-create-object
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "ACADVER") 1 2)
)
)
)
)
(vla-open odbx dwg)
(if (not
(setq
catch (vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda ()
(setq blkdbx
(vla-item (vla-get-blocks odbx) blk)
)
)
)
)
)
)
)
(vla-copyobjects
odbx
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list blkdbx)
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
)
(vlax-release-object odbx)
(if
(and (null catch)
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
blk
)
)
T
nil
)
)
nil
)
)

(defun copy-blk (dwg blk / blkdbx catch odbx) 
  (if (findfile dwg) 
    (progn 
      (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16) 
        (setq odbx (vlax-create-object "ObjectDBX.AxDbDocument")) 
        (setq odbx (vlax-create-object 
                     (strcat "ObjectDBX.AxDbDocument." 
                             (substr (getvar "ACADVER") 1 2) 
                     ) 
                   ) 
        ) 
      ) 
      (vla-open odbx dwg) 
      (if (not 
            (setq 
              catch (vl-catch-all-error-p 
                      (vl-catch-all-apply 
                        (function (lambda () 
                                    (setq blkdbx 
                                           (vla-item (vla-get-blocks odbx) blk) 
                                    ) 
                                  ) 
                        ) 
                      ) 
                    ) 
            ) 
          ) 
        (vla-copyobjects 
          odbx 
          (vlax-safearray-fill 
            (vlax-make-safearray vlax-vbObject '(0 . 0)) 
            (list blkdbx) 
          ) 
          (vla-get-blocks 
            (vla-get-activedocument (vlax-get-acad-object)) 
          ) 
        ) 
      ) 
      (vlax-release-object odbx) 
      (if 
        (and (null catch) 
             (vla-item (vla-get-blocks 
                         (vla-get-activedocument (vlax-get-acad-object)) 
                       ) 
                       blk 
             ) 
        ) 
         T 
         nil 
      ) 
    ) 
    nil 
  ) 
)

qqqincccken · 发表于 2017-5-26 00:09:24

谢谢提供，有空试试看！！！

yufeng37 · 发表于 2017-5-26 12:57:01

测试可用，好用的，非常犀利

zjh2785 · 发表于 2017-7-3 15:59:40

厉害找了很久了

bingshuier · 发表于 2017-7-27 13:05:13

这个很不错啊~~~~~~~~·

ScmTools · 发表于 2017-11-24 18:21:45

最好加上函数调用例子，比较直观以及教学

yzhyxh · 发表于 2017-11-25 08:26:20

w379106181 · 发表于 2018-1-13 10:07:16

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享

bonny123 · 发表于 2018-2-28 17:19:52

块定义？
测试下，有定义，无实体，空块。

kqqt6236 · 发表于 2018-3-3 00:06:54

这个厉害了！

qq2222081387 · 发表于 2018-7-18 14:00:58

这个功能非常好用啊

杨张张 · 发表于 2020-2-28 15:02:11

这个功能非常好用啊

ju5027 · 发表于 2020-2-28 22:36:22

支持楼主，看下隐藏的

小小的人 · 发表于 2020-4-7 00:27:57

这怎么运行的有人说一下吗

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

[每日一码] 不打开图形，从外部DWG拷贝一个块定义到当前图形

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分