同步当前图形中选定块的定义，与指定的文件中的块定义相同

vectra · 发表于 2018-5-3 17:37

外部文件中的块定义更新了，比如其它专业进行了修改，让当前图形中的同名块定义同步更新一直是个麻烦的事情，虽然用设计中心可以解决，但毕竟操作起来比较麻烦。所以绕了个远路，自己动手编写专用代码。

dbx相关的知识学习了gu版的贴，改进了一下，成了dbx类。

暂不支持嵌套块。

(vl-load-com)
;;; (p-dbx-open "D:\\Support\\Desktop\\drawing2.dwg")
;;;#<VLA-OBJECT IAxDbDocument 0bb21e70>
(defun p-dbx-open (filename / acver dbx)
(setq dbx (vla-getinterfaceobject
(vlax-get-acad-object)
(if (< (setq acver (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acver))
)
)
)
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-open (list dbx filename))
)
(progn
(p-dbx-close dbx)
(setq dbx nil)
)
)
(list (cons "AxDbDocument" dbx) (cons "FileName" filename))
)
(defun p-dbx-close (dbx /)
(setq dbx (p-dbx-getdocument dbx))
(vl-catch-all-apply 'vla-close (list dbx))
(vlax-release-object dbx)
(setq dbx nil)
)
(defun p-dbx-getdocument (dbx /)
(p-cls-get dbx "AxDbDocument")
)
(defun p-dbx-getfilename (dbx /)
(p-cls-get dbx "FileName")
)
(defun p-dbx-save (dbx / dbxdoc filename)
(setq filename (p-dbx-getfilename dbx)
dbxdoc (p-dbx-getdocument dbx)
)
(vl-catch-all-apply 'vla-saveas (list dbxdoc filename))
)
(defun p-dbx-saveas (dbx filename / dbxdoc)
(setq dbxdoc (p-dbx-getdocument dbx))
(vl-catch-all-apply 'vla-saveas (list dbxdoc filename))
)
(defun p-collection->list (collection / rv)
(vlax-for item collection
(setq rv (cons item rv))
)
(reverse rv)
)
(defun p-oblist->var (lst)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length lst)))
)
lst
)
)
)
(defun c:tt (/ dbx dest en filename name ss)
(princ "\n选择要同步的块:")
(if (and (setq ss (ssget ":E:S" '((0 . "INSERT"))))
(setq filename (getfiled "选择源文件" "" "dwg" 0))
)
(progn
(setq en (ssname ss 0)
name (p-dxf en 2)
dbx (p-dbx-open filename)
dest (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) name)
)
(vlax-for ob dest
(vla-delete ob)
)
(vla-copyobjects
(p-dbx-getdocument dbx)
(p-oblist->var
(p-collection->list (vla-item (vla-get-blocks (p-dbx-getdocument dbx)) name))
)
dest
)
(foreach en (p-ss->enames (ssget "X" (list '(0 . "INSERT") (cons 2 name))))
(entupd en)
)
(p-dbx-close dbx)
(princ "\n块已同步。")
)
)
(princ)
)
(defun p-cls-get (cls name / e)
(if (atom name)
(cdr (assoc name cls))
(mapcar '(lambda (e) (cdr (assoc e cls))) name)
)
)
(defun p-ss->enames (ss / en handles n)
(if ss
(progn
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n)))
handles (cons en handles)
)
)
)
)
handles
)
(defun p-dxf (ename codes / dxf)
(setq dxf (entget ename))
(if (atom codes)
(p-cls-get dxf codes)
(progn
(setq dxf (vl-remove-if
'(lambda (e)
(not (member (car e) codes))
)
dxf
)
)
(mapcar 'cdr dxf)
)
)
)

(vl-load-com) 
;;; (p-dbx-open "D:\\Support\\Desktop\\drawing2.dwg") 
;;;#<VLA-OBJECT IAxDbDocument 0bb21e70> 
(defun p-dbx-open (filename / acver dbx) 
  (setq        dbx (vla-getinterfaceobject 
              (vlax-get-acad-object) 
              (if (< (setq acver (atoi (getvar "ACADVER"))) 16) 
                "ObjectDBX.AxDbDocument" 
                (strcat "ObjectDBX.AxDbDocument." (itoa acver)) 
              ) 
            ) 
  ) 
  (if (vl-catch-all-error-p 
        (vl-catch-all-apply 'vla-open (list dbx filename)) 
      ) 
    (progn 
      (p-dbx-close dbx) 
      (setq dbx nil) 
    ) 
  ) 
  (list (cons "AxDbDocument" dbx) (cons "FileName" filename)) 
) 
 
 
(defun p-dbx-close (dbx /) 
  (setq dbx (p-dbx-getdocument dbx)) 
  (vl-catch-all-apply 'vla-close (list dbx)) 
  (vlax-release-object dbx) 
  (setq dbx nil) 
) 
 
 
(defun p-dbx-getdocument (dbx /) 
  (p-cls-get dbx "AxDbDocument") 
) 
 
 
(defun p-dbx-getfilename (dbx /) 
  (p-cls-get dbx "FileName") 
) 
 
 
(defun p-dbx-save (dbx / dbxdoc filename) 
  (setq        filename (p-dbx-getfilename dbx) 
        dbxdoc         (p-dbx-getdocument dbx) 
  ) 
  (vl-catch-all-apply 'vla-saveas (list dbxdoc filename)) 
) 
 
 
(defun p-dbx-saveas (dbx filename / dbxdoc) 
  (setq dbxdoc (p-dbx-getdocument dbx)) 
  (vl-catch-all-apply 'vla-saveas (list dbxdoc filename)) 
) 
 
 
(defun p-collection->list (collection / rv) 
  (vlax-for item collection 
    (setq rv (cons item rv)) 
  ) 
  (reverse rv) 
) 
 
 
(defun p-oblist->var (lst) 
  (vlax-make-variant 
    (vlax-safearray-fill 
      (vlax-make-safearray 
        vlax-vbobject 
        (cons 0 (1- (length lst))) 
      ) 
      lst 
    ) 
  ) 
) 
 
(defun c:tt (/ dbx dest en filename name ss) 
 
  (princ "\n选择要同步的块:") 
  (if (and (setq ss (ssget ":E:S" '((0 . "INSERT")))) 
           (setq filename (getfiled "选择源文件" "" "dwg" 0)) 
      ) 
    (progn 
      (setq en         (ssname ss 0) 
            name (p-dxf en 2) 
            dbx         (p-dbx-open filename) 
            dest (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) name) 
      ) 
 
      (vlax-for        ob dest 
        (vla-delete ob) 
      ) 
 
      (vla-copyobjects 
        (p-dbx-getdocument dbx) 
        (p-oblist->var 
          (p-collection->list (vla-item (vla-get-blocks (p-dbx-getdocument dbx)) name)) 
        ) 
        dest 
      ) 
 
      (foreach en (p-ss->enames (ssget "X" (list '(0 . "INSERT") (cons 2 name)))) 
        (entupd en) 
      ) 
 
      (p-dbx-close dbx) 
      (princ "\n块已同步。") 
    ) 
  ) 
  (princ) 
) 
 
 
(defun p-cls-get (cls name / e) 
  (if (atom name) 
    (cdr (assoc name cls)) 
    (mapcar '(lambda (e) (cdr (assoc e cls))) name) 
  ) 
) 
 
(defun p-ss->enames (ss / en handles n) 
  (if ss 
    (progn 
      (repeat (setq n (sslength ss)) 
        (setq en      (ssname ss (setq n (1- n))) 
              handles (cons en handles) 
        ) 
      ) 
    ) 
  ) 
  handles 
) 
 
(defun p-dxf (ename codes / dxf) 
  (setq dxf (entget ename)) 
 
  (if (atom codes) 
    (p-cls-get dxf codes) 
    (progn 
      (setq dxf        (vl-remove-if 
                  '(lambda (e) 
                     (not (member (car e) codes)) 
                   ) 
                  dxf 
                ) 
      ) 
      (mapcar 'cdr dxf) 
    ) 
  ) 
)

USER2128 · 发表于 2018-5-4 08:18

本帖最后由 USER2128 于 2018-5-4 09:31 编辑

大师的这个功能太好了！一直一来都想着如何实现这个功能。
提供一个自编的函数供参考，看是否能用上

;;;------------------------------------------------------------
;;; BY USER2128（HLCAD）.
;;; 列出图块名为blkname的所有块内块(嵌套块)名的集合:
;;; 集合中含blkname及所有块内块(嵌套块)名(不含无名块名及重复名)
;;; EX: (nst_BLKn_lst (cdr(assoc 2(entget(car(entsel))))))
(defun nst_BLKn_lst (blkname / names cnt ent elst blkn)
(setq names nil)
(setq cnt 0)
(and (= (type blkname) 'STR)
(/= blkname "")
(tblsearch "BLOCK" blkname)
(setq names (list blkname))
)
(while (< cnt (length names))
(and (setq ent (tblsearch "BLOCK" (nth cnt names)))
(setq elst (entget (setq ent (cdr (assoc '-2 ent)))))
(while ent
(and (= "INSERT" (cdr (assoc '0 elst)))
(setq blkn (cdr (assoc '2 elst)))
(or (member blkn names)
(setq names (append names (list blkn)))
))
(and (setq ent (entnext ent))
(setq elst (entget ent))
)
))
(setq cnt (1+ cnt))
)
(vl-remove-if '(lambda(x) (wcmatch x "`**")) names)
)
;;;------------------------------------------------------------

;;;------------------------------------------------------------ 
;;; BY USER2128（HLCAD）. 
;;; 列出图块名为blkname的所有块内块(嵌套块)名的集合: 
;;; 集合中含blkname及所有块内块(嵌套块)名(不含无名块名及重复名) 
;;; EX: (nst_BLKn_lst (cdr(assoc 2(entget(car(entsel)))))) 
(defun nst_BLKn_lst (blkname / names cnt ent elst blkn) 
  (setq names nil) 
  (setq cnt 0) 
  (and (= (type blkname) 'STR) 
       (/= blkname "") 
       (tblsearch "BLOCK" blkname) 
       (setq names (list blkname)) 
       ) 
  (while (< cnt (length names)) 
    (and (setq ent (tblsearch "BLOCK" (nth cnt names))) 
   (setq elst (entget (setq ent (cdr (assoc '-2 ent))))) 
   (while ent 
     (and (= "INSERT" (cdr (assoc '0 elst))) 
    (setq blkn  (cdr (assoc '2 elst))) 
    (or (member blkn names) 
        (setq names (append names (list blkn))) 
        )) 
     (and (setq ent (entnext ent)) 
    (setq elst (entget ent)) 
    ) 
     )) 
    (setq cnt (1+ cnt)) 
    ) 
  (vl-remove-if '(lambda(x) (wcmatch x "`**")) names) 
  ) 
;;;------------------------------------------------------------

mikewolf2k · 发表于 2018-5-7 16:56

如果只是为了更新块，应该通过脚本将重新插入块（同时从定义块），然后删除刚才插入的块就可以完成了，用excel相应的插入块命令放在脚本文件里批量执行即可。依稀记得以前做过类似的事情。

ruirui999 · 发表于 2018-5-3 17:48

这个功能太好了。

Linhay · 发表于 2018-5-3 18:41

这个必须给点赞，梦寐以求的功能。
以前只能用设计中心，或者插入块来解决，效率特别低。

vectra · 发表于 2018-5-4 20:23

倘若有十万个对象的块只更新了一两个对象，现在会删除这十万个对象，再全部重新生成一遍，非常之不科学

暂时没有深入做下去是感觉应该先实现一个对象比较功能，只更新有修改的对象。

烟盒迷唇 · 发表于 2018-5-7 09:46

好用的代码啊，学习了

马甲 · 发表于 2018-5-12 09:26

好用的代码啊，学习了

头大无恼 · 发表于 2018-5-12 15:20

学习了，实用啊

magicheno · 发表于 2022-5-17 20:56

感谢大佬分享

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

[源码] 同步当前图形中选定块的定义，与指定的文件中的块定义相同

点评

评分

本帖被以下淘专辑推荐: