插入图块，同时更新图块(修正版)

stgpmin

最近爬文寻找插入图块并更新块中块的方法，感谢Gu_xl大大的于2013年的源码提供。不过也许是CAD版本替换，导致程序运行失败
经过反覆debug，确认是标注的图块问题，因本人水平不高，只能先通过由标注的图块命名原则为字首“ _”，在图块名称中选择增加一行程序码，将标注图块筛选掉。若使用上有问题，可能是因为我使用繁体的关系，网友们可以自行修改掉这一行。
（=“ _”（substr（vla-get-name blk）1 1））
改善的，平时作业时图块命名就要避开以“ _”为字首。
另外因为本人使用上习惯将图块W出去，修改后再insert回来，所以增加了这个功能，能将欲插入的档案本身视为图块更新。
使用上要先拾取图档内欲更新的图块，此动作是为了快速获取图块名称，用substr指令应该也可以达成。
接着就是选择要插入的档案，若图块很多，会停止重新插入，然后就是插入图块，可以在选择插入点时按esc取消它，就完成更新图块的工作
再次感谢Gu_xl大大，解决我长久以来困扰的问题。这方式可以做为在多人协作时，不使用外部参考的解决方案。

2. ;;插入圖塊，同時更新圖塊 By Gu_xl 2013.04.02
   
3. (defun c:ibb (/  DWGNAME     DBXDOC       ACVER
   
4.                      DBXMODELSPACE             BLOCKS
   
5.                      DOC          DBXBLOCKNAMES
   
6.                      OBJS
   
7.                      )
   
8.         ;;獲取圖塊名稱
   
9.         (setq bss (entsel))
   
10.         (setq eN1 (car bss))
    
11.         (setq EN1_data (entget EN1))
    
12.         (setq b_name (cdr (assoc 2 EN1_data)))
    
13.          
    
14.         ;;結束
    
15.   (setq DwgName (GETFILED "選擇要插入的圖塊文件" "" "dwg" 4))
    
16.   (setq dwgname2 (strcat b_name "=" dwgname))
    
17.   (if (and
    
18.         DwgName
    
19.         (not
    
20.           (equal
    
21.             (strcase DwgName)
    
22.             (strcase (strcat (getvar "dwgprefix") (getvar "dwgname")))
    
23.             )
    
24.           )
    
25.         )
    
26.     (progn
    
27.       (setq
    
28.         DBXDOC (vla-GetInterfaceObject
    
29.                  (vlax-get-acad-object)
    
30.                  (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
    
31.                    "ObjectDBX.AxDbDocument"
    
32.                    (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
    
33.                    )
    
34.                  )
    
35.         )
    
36.       (vla-open DBXDOC DWGNAME)
    
37.       (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
    
38.       (setq blocks (vla-get-blocks
    
39.                      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
    
40.                      )
    
41.             )
    
42.       (vlax-for blk (vla-get-blocks DBXDOC)
    
43.         (if (not (or (eq :vlax-true (vla-get-isXRef blk))
    
44.                      (eq :vlax-true (vla-get-isLayout blk))
    
45.                      (= "*U" (substr (vla-get-name blk) 1 2))
    
46.                      (= "*D" (substr (vla-get-name blk) 1 2))
    
47.                      (= "*T" (substr (vla-get-name blk) 1 2))
    
48.                      (= "_" (substr (vla-get-name blk) 1 1))
    
49.                      )
    
50.                  )
    
51.           (setq dbxblocknames (cons (vla-get-name blk) dbxblocknames))
    
52.           )
    
53.         )
    
54.       (setq dbxblocknames
    
55.              (vl-remove-if-not '(lambda (x) (TBLSEARCH "BLOCK" x)) dbxblocknames)
    
56.             )
    
57.       (if dbxblocknames
    
58.         (progn
    
59.           (foreach block dbxblocknames
    
60.             (vlax-for obj (vla-item blocks block)
    
61.               (vla-delete obj)
    
62.               )
    
63.             (setq objs nil)
    
64.             (vlax-invoke
    
65.               dbxDoc
    
66.               'CopyObjects
    
67.               (vlax-for a
    
68.                 (vla-item (vla-get-blocks DBXDOC) block)
    
69.                 (setq objs (cons a objs))
    
70.                 )
    
71.               (vla-item blocks block)
    
72.               )
    
73.             )
    
74.           (vla-regen doc :vlax-true)
    
75.           (prompt (strcat "\n更新了" (itoa (length dbxblocknames)) "個圖塊！"))
    
76.           )
    
77.         (prompt "\n沒有可更新的圖塊！")
    
78.         )
    
79.       (vlax-release-object DBXDOC)
    
80.       (command "insert" DwgName2)
    
81.       (while (= 1 (logand (getvar 'cmdactive) 1))
    
82.         (command pause)
    
83.         )
    
84.       )
    
85.     )
    
86.   (princ)
    
87. )  

;;插入圖塊，同時更新圖塊 By Gu_xl 2013.04.02<br /> (defun c:ibb (/  DWGNAME     DBXDOC       ACVER<br />                      DBXMODELSPACE             BLOCKS<br />                      DOC          DBXBLOCKNAMES<br />                      OBJS<br />                      )<br />         ;;獲取圖塊名稱<br />         (setq bss (entsel))<br />         (setq eN1 (car bss))<br />         (setq EN1_data (entget EN1))<br />         (setq b_name (cdr (assoc 2 EN1_data)))<br />           <br />         ;;結束<br />   (setq DwgName (GETFILED "選擇要插入的圖塊文件" "" "dwg" 4))<br />   (setq dwgname2 (strcat b_name "=" dwgname))<br />   (if (and<br />         DwgName<br />         (not<br />           (equal<br />             (strcase DwgName)<br />             (strcase (strcat (getvar "dwgprefix") (getvar "dwgname")))<br />             )<br />           )<br />         )<br />     (progn<br />       (setq<br />         DBXDOC (vla-GetInterfaceObject<br />                  (vlax-get-acad-object)<br />                  (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)<br />                    "ObjectDBX.AxDbDocument"<br />                    (strcat "ObjectDBX.AxDbDocument." (itoa acVer))<br />                    )<br />                  )<br />         )<br />       (vla-open DBXDOC DWGNAME)<br />       (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))<br />       (setq blocks (vla-get-blocks<br />                      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br />                      )<br />             )<br />       (vlax-for blk (vla-get-blocks DBXDOC)<br />         (if (not (or (eq :vlax-true (vla-get-isXRef blk))<br />                      (eq :vlax-true (vla-get-isLayout blk))<br />                      (= "*U" (substr (vla-get-name blk) 1 2))<br />                      (= "*D" (substr (vla-get-name blk) 1 2))<br />                      (= "*T" (substr (vla-get-name blk) 1 2))<br />                      (= "_" (substr (vla-get-name blk) 1 1))<br />                      )<br />                  )<br />           (setq dbxblocknames (cons (vla-get-name blk) dbxblocknames))<br />           )<br />         )<br />       (setq dbxblocknames<br />              (vl-remove-if-not '(lambda (x) (TBLSEARCH "BLOCK" x)) dbxblocknames)<br />             )<br />       (if dbxblocknames<br />         (progn<br />           (foreach block dbxblocknames<br />             (vlax-for obj (vla-item blocks block)<br />               (vla-delete obj)<br />               )<br />             (setq objs nil)<br />             (vlax-invoke<br />               dbxDoc<br />               'CopyObjects<br />               (vlax-for a<br />                 (vla-item (vla-get-blocks DBXDOC) block)<br />                 (setq objs (cons a objs))<br />                 )<br />               (vla-item blocks block)<br />               )<br />             )<br />           (vla-regen doc :vlax-true)<br />           (prompt (strcat "\n更新了" (itoa (length dbxblocknames)) "個圖塊！"))<br />           )<br />         (prompt "\n沒有可更新的圖塊！")<br />         )<br />       (vlax-release-object DBXDOC)<br />       (command "insert" DwgName2)<br />       (while (= 1 (logand (getvar 'cmdactive) 1))<br />         (command pause)<br />         )<br />       )<br />     )<br />   (princ)<br /> )  

stgpmin

CAD新军 发表于 2019-12-4 16:39
能不能给一下老大的原来的代码。我不是信不过你，我只是想先用老大的版本试试能不能用

OK的，連結在此，在3樓
http://bbs.mjtd.com/forum.php?mo ... 9132&fromuid=235946

1. http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=100770&pid=579132&fromuid=235946

复制代码

stgpmin

andyzha 发表于 2019-12-4 11:04
你的lisp是不是打开一个文件，选择特定要更新的同名块，然后选择更新源文件，实现更新现在打开的文件块文件 ...

對，但我的LISP在選擇特定要更新的塊時，不一定要同名，方便源文件在命名時可以標示時間或版次，該更新塊會更名為源文件檔名。至於塊中塊則會保持原本的塊名

andyzha

代码在哪儿呢？

这个其实是很多作图者的痛点，多人协作改图，局部更新，却需要全局汇总的时候都更新过来

G大很多年前的代码基本上解决的这个痛点，但是有个小小的遗憾，如果是动态块做的，更新以后，动态块的属性，例如拉伸，就失效了。

期待明经的哪个大神能完美的解决这个小遗憾了。

stgpmin

andyzha 发表于 2019-12-3 16:01
代码在哪儿呢？

这个其实是很多作图者的痛点，多人协作改图，局部更新，却需要全局汇总的时候都更 ...

哈，奇怪，我使用代碼功能，結果代碼都不見了，我原本還把繁體字都轉成簡體字，這下子都沒有了，繁體字先頂著用。

andyzha

你的lisp是不是打开一个文件，选择特定要更新的同名块，然后选择更新源文件，实现更新现在打开的文件块文件的目的？

CAD新军

能不能给一下老大的原来的代码。我不是信不过你，我只是想先用老大的版本试试能不能用

by361973435

请问，动态块无法更新，能有什么方法解决吗？

wosiguwozai0830

这太厉害了，能更新块中的子块，找了这个功能很久了，感谢 感谢！

Quon

感谢楼主分享