hnfsf 发表于 2013-4-10 17:51:02

插入重名图块

用CTRL+V 插入一个图块，如果被插入的图中存在同名的块（或嵌套块），则提示更新被插入图中的块，或者用新插入的块更新原图中的块，或者将要插入的块重命名插入（避免变成了同名的原图块）

wowan1314 发表于 2013-4-10 18:00:47

http://bbs.mjtd.com/thread-100770-1-1.html

hnfsf 发表于 2013-4-10 19:35:18

这个看到了的，G版的大作，但那是用插入文件的方式插入，通过文件名提取文件中的图块，进行后面的操作。
用CTRL+V的方式，需要从剪贴板里面读取里面包含的图块，后面的操作应该是一样的，但是从剪贴板读取里面包含的图块不懂怎么读。

wowan1314 发表于 2013-4-10 20:33:19

是我唐突了，没细看帖子！
按你的意思估计得重写Carl+v的程序了！
却不知道lsp能否弄出！估计悬

hnfsf 发表于 2013-4-11 01:43:34

(defun c:ck (/ ss pt dwgname dbxdoc acver dbxmodelspace blocks doc dbxblocknames objs)
(setvar "CMDECHO" 0)
(setvar "FILEDIA" 0)
(vl-load-com)
(if (setq ss (ssget))
   (progn
       (setq pt (getpoint "\n插入点：")
             dwgname (rtos (fix (* 1000000 (getvar "Cdate"))) 2 0))
       (vl-cmdf "-wblock" dwgname "" pt ss "")
       (dos_clipboard dwgname)
       (vl-cmdf "oops")
       (exit))
   (if (and (setq @@str (dos_clipboard))(= 14 (strlen @@str)))
         (setq dwgname (findfile (strcat @@str ".dwg")))
         (setq dwgname (getfiled "选择引入图块的DWG文件" "" "dwg" 4))))
(setvar "FILEDIA" 1)
(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)
      (vl-cmdf "-insert" dwgname pause "" "" "")
      (vl-cmdf "_explode" (entlast))
      (while (= 1 (logand (getvar 'cmdactive) 1))
      (command pause)
      )
    )
)
(princ)
)

风流少年时 发表于 2015-11-11 19:17:20

hnfsf 发表于 2013-4-11 01:43 static/image/common/back.gif
(defun c:ck (/ ss pt dwgname dbxdoc acver dbxmodelspace blocks doc dbxblocknames objs)
(setvar "C ...

dos_clipboard这个函数漏掉了？

一余二水 发表于 2016-3-24 12:40:09

看不懂，怎么办

bing00 发表于 2023-8-18 14:30:09

试了下5楼的，不能用吧
页: [1]
查看完整版本: 插入重名图块