插入图块，同时更新图块(修正版)
本帖最后由 stgpmin 于 2019-12-3 16:16 编辑最近爬文寻找插入图块并更新块中块的方法，感谢Gu_xl大大的于2013年的源码提供。不过也许是CAD版本替换，导致程序运行失败
经过反覆debug，确认是标注的图块问题，因本人水平不高，只能先通过由标注的图块命名原则为字首“ _”，在图块名称中选择增加一行程序码，将标注图块筛选掉。若使用上有问题，可能是因为我使用繁体的关系，网友们可以自行修改掉这一行。
（=“ _”（substr（vla-get-name blk）1 1））
改善的，平时作业时图块命名就要避开以“ _”为字首。
另外因为本人使用上习惯将图块W出去，修改后再insert回来，所以增加了这个功能，能将欲插入的档案本身视为图块更新。
使用上要先拾取图档内欲更新的图块，此动作是为了快速获取图块名称，用substr指令应该也可以达成。
接着就是选择要插入的档案，若图块很多，会停止重新插入，然后就是插入图块，可以在选择插入点时按esc取消它，就完成更新图块的工作
再次感谢Gu_xl大大，解决我长久以来困扰的问题。这方式可以做为在多人协作时，不使用外部参考的解决方案。
static/image/hrline/1.gif
;;插入圖塊，同時更新圖塊 By Gu_xl 2013.04.02
(defun c:ibb (/DWGNAME DBXDOC ACVER
DBXMODELSPACE BLOCKS
DOC DBXBLOCKNAMES
OBJS
)
;;獲取圖塊名稱
(setq bss (entsel))
(setq eN1 (car bss))
(setq EN1_data (entget EN1))
(setq b_name (cdr (assoc 2 EN1_data)))
;;結束
(setq DwgName (GETFILED "選擇要插入的圖塊文件" "" "dwg" 4))
(setq dwgname2 (strcat b_name "=" dwgname))
(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))
(= "_" (substr (vla-get-name blk) 1 1))
)
)
(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)
(command "insert" DwgName2)
(while (= 1 (logand (getvar 'cmdactive) 1))
(command pause)
)
)
)
(princ)
)
CAD新军 发表于 2019-12-4 16:39
能不能给一下老大的原来的代码。我不是信不过你，我只是想先用老大的版本试试能不能用
OK的，連結在此，在3樓
http://bbs.mjtd.com/forum.php?mo ... 9132&fromuid=235946
http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=100770&pid=579132&fromuid=235946 andyzha 发表于 2019-12-4 11:04
你的lisp是不是打开一个文件，选择特定要更新的同名块，然后选择更新源文件，实现更新现在打开的文件块文件 ...
對，但我的LISP在選擇特定要更新的塊時，不一定要同名，方便源文件在命名時可以標示時間或版次，該更新塊會更名為源文件檔名。至於塊中塊則會保持原本的塊名 代码在哪儿呢？
这个其实是很多作图者的痛点，多人协作改图，局部更新，却需要全局汇总的时候都更新过来
G大很多年前的代码基本上解决的这个痛点，但是有个小小的遗憾，如果是动态块做的，更新以后，动态块的属性，例如拉伸，就失效了。
期待明经的哪个大神能完美的解决这个小遗憾了。 andyzha 发表于 2019-12-3 16:01
代码在哪儿呢？
这个其实是很多作图者的痛点，多人协作改图，局部更新，却需要全局汇总的时候都更 ...
哈，奇怪，我使用代碼功能，結果代碼都不見了，我原本還把繁體字都轉成簡體字，這下子都沒有了，繁體字先頂著用。 你的lisp是不是打开一个文件，选择特定要更新的同名块，然后选择更新源文件，实现更新现在打开的文件块文件的目的？ 能不能给一下老大的原来的代码。我不是信不过你，我只是想先用老大的版本试试能不能用 请问，动态块无法更新，能有什么方法解决吗？ 这太厉害了，能更新块中的子块，找了这个功能很久了，感谢 感谢！ 感谢楼主分享
页:
[1]
2