andyzha 发表于 2020-1-15 10:20:52

反向替换块,替换以后会导致动态块丢失动态属性,求助!

本帖最后由 andyzha 于 2020-1-15 10:22 编辑

初衷:经常使用块作图,但是一张图纸可能两个人在修改,两个人都修改了一部分块,想直接在自己的文件里把别人修改的块替换过来,论坛里的大佬提供了一个反向替换块的方案,很好用,但是还有有点bug,就是如果替换块中有动态块,直接导致动态块失效,动态属性用不了。求高手完善一下,不胜感激。:lol

附上源码,供参考。

MM-替换同名块
(defun c:MM (/ DWGNAME      DBXDOC       ACVER
                     DBXMODELSPACE             BLOCKS
                     DOC          DBXBLOCKNAMES
                     OBJS
                     )
(setq DwgName (GETFILED "选择引入图块的DWG文件" "" "dwg" 4))
(if (and
      DwgName
      (not
          (equal
            (strcase DwgName)
            (strcase (strcat (getvar "dwgprefix") (getvar "dwgname")))
            )
          )
      )
    (progn
      (setq
      DBXDOC (vla-GetInterfaceObject
               (vlax-get-acad-object)
               (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
                   "ObjectDBX.AxDbDocument"
                   (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
                   )
               )
      )
      (vla-open DBXDOC DWGNAME)
      (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
      (setq blocks (vla-get-blocks
                     (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
                     )
            )
      (vlax-for blk (vla-get-blocks DBXDOC)
      (if (not (or (eq :vlax-true (vla-get-isXRef blk))
                     (eq :vlax-true (vla-get-isLayout blk))
                     (= "*U" (substr (vla-get-name blk) 1 2))
                     (= "*D" (substr (vla-get-name blk) 1 2))
                     (= "*T" (substr (vla-get-name blk) 1 2))
                     )
               )
          (setq dbxblocknames (cons (vla-get-name blk) dbxblocknames))
          )
      )
      (setq dbxblocknames
             (vl-remove-if-not
               '(lambda (x) (TBLSEARCH "BLOCK" x))
               dbxblocknames
               )
            )
      (if dbxblocknames
      (progn
          (foreach block dbxblocknames
            (vlax-for obj (vla-item blocks block)
            (vla-delete obj)
            )
            (setq objs nil)
            (vlax-invoke
            dbxDoc
            'CopyObjects
            (vlax-for a
                (vla-item (vla-get-blocks DBXDOC) block)
                (setq objs (cons a objs))
                )
            (vla-item blocks block)
            )
            )
          (vla-regen doc :vlax-true)
          (prompt (strcat "\n更新了" (itoa (length dbxblocknames)) "个图块!"))
          )
      (prompt "\n没有可更新的图块!")
      )
      (vlax-release-object DBXDOC)
      )
    )
(princ)
)

andyzha 发表于 2020-1-15 16:45:04

这个是很多作图人的痛点,希望大神关注一下

ywx2020 发表于 2020-4-21 07:29:15

我也一直在找关于动态块自定义属性

LoyaltyMu 发表于 2020-7-10 23:52:28

这个代码运行不了啊

peter1991 发表于 2025-1-14 18:39:46

用ctrl+2就可以
页: [1]
查看完整版本: 反向替换块,替换以后会导致动态块丢失动态属性,求助!