本帖最后由 作者 于 2009-3-5 15:24:15 编辑
![](source/plugin/imc_colorcode/images/loading.gif) - ;;修改同名塊
- ;;BY LUCAS
- ;;注意:修改後圖檔會失去預覽,處理的圖檔非打開中
- (defun C:CH_BLKS_NAME (/ DBXDOC DWGNAME FNAME HOLDECHO NAME1 NN PREFIX_DWG QQ)
- (vl-load-com)
- (setq HOLDECHO (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (setq PREFIX_DWG
- (strcat
- (strcase (acet-ui-pickdir
- "選擇目錄"
- (vl-string-right-trim "\" (getvar "dwgprefix"))
- "更改同名塊"
- )
- )
- "\"
- )
- )
- (setq QQ (vl-directory-files PREFIX_DWG "*.DWG"))
- (if (/= QQ NIL)
- (progn
- (setq DBXDOC (vla-getinterfaceobject
- (vlax-get-acad-object)
- (strcat "ObjectDBX.AxDbDocument."
- (substr (getvar "AcadVer") 1 2)
- )
- )
- )
- (setq NN 0)
- (repeat (length QQ)
- (setq DWGNAME (strcase (strcat PREFIX_DWG (nth NN QQ))))
- (vla-open DBXDOC DWGNAME)
- (vlax-for NAME (vla-get-blocks DBXDOC)
- (if (eq (setq NAME1 (strcase (vla-get-name NAME)))
- (strcase (vl-filename-base DWGNAME))
- )
- (progn
- (prompt (strcat "\n" DWGNAME "---發現同名塊,已修改完成!"))
- (vla-put-name NAME (strcat NAME1 "-new"))
- (vla-saveas DBXDOC DWGNAME)
- )
- )
- )
- (setq NN (1+ NN))
- )
- (vlax-release-object DBXDOC)
- )
- )
- (setvar "cmdecho" HOLDECHO)
- (princ)
- )
|