[求助]多文件里的普通块

2556596 · 发表于 2010-7-29 23:24:00

几十张的图纸文件，里面都有一个同样的普通的块，文字的块（就是标题栏里的姓名，时间，重量这些），全是文字，有没有什么方法可以把这几十个文件里的块里的某几个字，比如姓名，时间什么的，批量改成别的呢？（最早画图的时候，很笨，直接用单行文字写的这些东西，然后排好队形，复制，然后是直接粘贴为块，然后就是把这个名字是自动生成的块，拿来复制粘贴到不同的文件里了。。。。。。）现在要一个一个文件改的话太麻烦了，有否办法能批量修改呢？谢谢了！

Gu_xl · 发表于 2010-7-30 10:15:00

本帖最后由作者于 2010-8-3 12:24:48 编辑

;;;(gxl-DBX-ReplaceText '((源文本 . 目标文本)...) 文件名替换方式) 利用ObjectDBX技术不打开DWG文件替换文本,Flag 0 仅替换文字 1 仅替换块中文字 2 全部替换
(defun gxl-DBX-ReplaceText (TextList;SourceText TargetText
DwgName Flag /
RegObjectDBX
DBXModelSpace DBXDOC
count
)
(setq *ACAD* (vlax-get-acad-object)
*AcDocument* (vla-get-activedocument *Acad*)
*Model-Space* (vla-get-modelspace *AcDocument*)
)
(defun RegObjectDBX (/ DBXSERVER)
;by Tony Tanzillo
(cond ((vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
) ;_ vl-registry-read
)
((not (setq DBXSERVER (findfile "AxDb15.dll")))
(alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
)
(t
(startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
(or (vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
) ;_ vl-registry-read
(alert
"Error: Failed to register ObjectDBX ActiveX services."
) ;_ alert
) ;_ or
)
) ;_ cond
) ;_ defun
(setq DwgName (findfile DwgName))
(if DwgName
(progn
(if (= "15" (substr (getvar "acadver") 1 2))
(progn (if (not (RegObjectDBX))
(exit)
) ;_ if
(setq
DBXDOC (vla-getinterfaceobject
*ACAD*
"ObjectDBX.AxDbDocument"
) ;_ vla-getinterfaceobject
) ;_ setq
) ;_ progn
(setq
DBXDOC (vla-getinterfaceobject
*ACAD*
"ObjectDBX.AxDbDocument.16"
) ;_ vla-getinterfaceobject
) ;_ setq
) ;_ if
(setq FileName (strcat (getvar "dwgprefix") (getvar "dwgname")))
(if (equal (strcase FileName) (strcase DWGNAME))
(setq DBXModelSpace *MODEL-SPACE*
DBXDOC *ACDOCUMENT*) ;_ setq
(progn (vla-open DBXDOC DWGNAME)
(setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
) ;_ progn
) ;_ if
(cond ((= 0 Flag)
(setq count 0)
(vlax-for obj DBXModelSpace
(cond ((= "AcDbText" (vla-get-ObjectName obj))
(if (assoc (vla-Get-textString obj) TextList)
(progn
(vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)))
(setq count (1+ count))
) ;_ progn
) ;_ if
)
) ;_ cond
) ;_ vlax-for
)
((= 1 Flag)
(setq count 0)
(setq blocks (vla-get-Blocks DBXDOC))
(vlax-for block blocks
(vlax-for obj block
(cond ((= "AcDbText" (vla-get-ObjectName obj))
(if (assoc (vla-Get-textString obj) TextList)
(progn
(vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)))
(setq count (1+ count))
) ;_ progn
) ;_ if
)
) ;_ cond
)
)
)
((= 2 Flag)
(setq count 0)
(vlax-for obj DBXModelSpace
(cond ((= "AcDbText" (vla-get-ObjectName obj))
(if (assoc (vla-Get-textString obj) TextList);(= SourceText (vla-Get-textString obj))
(progn
(vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)));(vla-put-TextString obj TargetText)
(setq count (1+ count))
) ;_ progn
) ;_ if
)
) ;_ cond
) ;_ vlax-for
(setq blocks (vla-get-Blocks DBXDOC))
(vlax-for block blocks
(vlax-for obj block
(cond ((= "AcDbText" (vla-get-ObjectName obj))
(if (= SourceText (vla-Get-textString obj))
(progn
(vla-put-TextString obj TargetText)
(setq count (1+ count))
) ;_ progn
) ;_ if
)
) ;_ cond
)
)
)
) ;_ 结束cond
(if (equal (strcase FileName) (strcase DWGNAME))
(vla-Save *AcDocument*)
(vla-Saveas DBXDOC DWGNAME)
)
(vlax-release-object DBXDOC)
count
) ;_ progn
) ;_ if
) ;_ defun
;;;要替换的文件放在同一目录下，调用命令：gxl-RePlaceText
(defun c:gxl-RePlaceText (/ source Target strFolder DwgList n TextList)
(princ "\n程序编制by Gu_xl,2010年7月")
(setq source (getstring "\n输入源文字:"))
(setq Target (getstring "\n输入要替换的文字:"))
(setq TextList (append TextList (list (cons source Target))))
(initget 7 "Yes No ")
(setq kd (getkword "\n继续输入替换文字[Yes/No]<Yes>:"))
(if (= "" kd) (setq kd "Yes"))
(while (= kd "Yes")
(setq source (getstring "\n输入源文字:"))
(setq Target (getstring "\n输入要替换的文字:"))
(setq TextList (append TextList (list (cons source Target))))
(initget 7 "Yes No ")
(setq kd (getkword "\n继续输入替换文字[Yes/No]<Yes>:"))
(if (= "" kd)
(setq kd "Yes")
) ;_ if
) ;_ while
(initget 7 "0 1 2 ")
(setq kd (getkword "\n替换方式[仅替换文本<0>/仅替换块中文本<1>/全部替换<2>]仅替换文本<0>:"))
(if (= "" kd) (setq kd "0"))
(setq kd (read kd))
(setq strFolder (GXL-FILE-GETFOLDER "选择替换文件夹"))
(setq DwgList (VL-DIRECTORY-FILES strFolder "*.dwg" kd))
(if DwgList
(progn
(setq n 0)
(princ "\n 正在查找替换文本，请等待...")
(princ)
(foreach dwg DwgList
(setq n (+ n (gxl-DBX-ReplaceText TextList (strcat strFolder "\" dwg) 1)))
)
)
)
(princ (strcat "\n 共完成 " (itoa n) " 处文本替换！"))
(princ)
)

;;;(gxl-DBX-ReplaceText '((源文本 . 目标文本)...) 文件名 替换方式) 利用ObjectDBX技术不打开DWG文件替换文本,Flag 0 仅替换文字 1 仅替换块中文字 2 全部替换
(defun gxl-DBX-ReplaceText (TextList;SourceText    TargetText
       DwgName Flag   /
       RegObjectDBX
       DBXModelSpace  DBXDOC
       count
      )
 
  (setq *ACAD* (vlax-get-acad-object)
 *AcDocument* (vla-get-activedocument *Acad*)
      *Model-Space* (vla-get-modelspace *AcDocument*)
 )
   (defun RegObjectDBX (/ DBXSERVER)
     ;by Tony Tanzillo
    (cond ((vl-registry-read
      "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
    ) ;_ vl-registry-read
   )
   ((not (setq DBXSERVER (findfile "AxDb15.dll")))
    (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
   )
   (t
    (startapp "regsvr32.exe" (strcat "/s "" DBXSERVER """))
    (or (vl-registry-read
   "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
        ) ;_ vl-registry-read
        (alert
   "Error: Failed to register ObjectDBX ActiveX services."
        ) ;_ alert
    ) ;_ or
   )
    ) ;_ cond
  ) ;_ defun
  (setq DwgName (findfile DwgName))
  (if DwgName
    (progn
      (if (= "15" (substr (getvar "acadver") 1 2))
 (progn (if (not (RegObjectDBX))
   (exit)
        ) ;_ if
        (setq
   DBXDOC (vla-getinterfaceobject
     *ACAD*
     "ObjectDBX.AxDbDocument"
   ) ;_ vla-getinterfaceobject
        ) ;_ setq
 ) ;_ progn
 (setq
   DBXDOC (vla-getinterfaceobject
     *ACAD*
     "ObjectDBX.AxDbDocument.16"
   ) ;_ vla-getinterfaceobject
 ) ;_ setq
      ) ;_ if
      (setq FileName (strcat (getvar "dwgprefix") (getvar "dwgname")))
      (if (equal (strcase FileName) (strcase DWGNAME))
 (setq DBXModelSpace *MODEL-SPACE*
       DBXDOC *ACDOCUMENT*) ;_ setq
 (progn (vla-open DBXDOC DWGNAME)
        (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
 ) ;_ progn
      ) ;_ if
      (cond ((= 0 Flag)
      (setq count 0)
      (vlax-for obj DBXModelSpace
        (cond ((= "AcDbText" (vla-get-ObjectName obj))
        (if (assoc (vla-Get-textString obj) TextList)
   (progn
     (vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)))
     (setq count (1+ count))
   ) ;_ progn
        ) ;_ if
       )
        ) ;_ cond
      ) ;_ vlax-for
     )
     ((= 1 Flag)
      (setq count 0)
      (setq blocks (vla-get-Blocks DBXDOC))
      (vlax-for block blocks
        (vlax-for obj block
        (cond ((= "AcDbText" (vla-get-ObjectName obj))
        (if (assoc (vla-Get-textString obj) TextList)
   (progn
     (vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)))
     (setq count (1+ count))
   ) ;_ progn
        ) ;_ if
       )
        ) ;_ cond
      )
        )
      )
     ((= 2 Flag)
      (setq count 0)
      (vlax-for obj DBXModelSpace
        (cond ((= "AcDbText" (vla-get-ObjectName obj))
        (if (assoc (vla-Get-textString obj) TextList);(= SourceText (vla-Get-textString obj))
   (progn
     (vla-put-TextString obj (cdr (assoc (vla-Get-textString obj) TextList)));(vla-put-TextString obj TargetText)
     (setq count (1+ count))
   ) ;_ progn
        ) ;_ if
       )
        ) ;_ cond
      ) ;_ vlax-for
      (setq blocks (vla-get-Blocks DBXDOC))
      (vlax-for block blocks
        (vlax-for obj block
        (cond ((= "AcDbText" (vla-get-ObjectName obj))
        (if (= SourceText (vla-Get-textString obj))
   (progn
     (vla-put-TextString obj TargetText)
     (setq count (1+ count))
   ) ;_ progn
        ) ;_ if
       )
        ) ;_ cond
      )
        )
      
      )
      ) ;_ 结束cond
      (if (equal (strcase FileName) (strcase DWGNAME))
 (vla-Save *AcDocument*)
      (vla-Saveas DBXDOC DWGNAME)
 )
      (vlax-release-object DBXDOC)
      count
    ) ;_ progn
  ) ;_ if
) ;_ defun
;;;要替换的文件放在同一目录下，调用命令：gxl-RePlaceText

(defun c:gxl-RePlaceText (/ source Target strFolder DwgList n TextList)
  (princ "\n程序编制by Gu_xl,2010年7月")
  (setq source (getstring "\n输入源文字:"))
  (setq Target (getstring "\n输入要替换的文字:"))
  (setq TextList (append TextList (list (cons source Target))))
  (initget 7 "Yes No  ")
  (setq kd (getkword "\n继续输入替换文字[Yes/No]<Yes>:"))
  (if (= "" kd) (setq kd "Yes"))
  (while (= kd "Yes")
    (setq source (getstring "\n输入源文字:"))
    (setq Target (getstring "\n输入要替换的文字:"))
    (setq TextList (append TextList (list (cons source Target))))
    (initget 7 "Yes No  ")
    (setq kd (getkword "\n继续输入替换文字[Yes/No]<Yes>:"))
    (if (= "" kd)
      (setq kd "Yes")
    ) ;_ if
  ) ;_ while
  (initget 7 "0 1 2  ")
  (setq kd (getkword "\n替换方式[仅替换文本<0>/仅替换块中文本<1>/全部替换<2>]仅替换文本<0>:"))
  (if (= "" kd) (setq kd "0"))
  (setq kd (read kd))
  (setq strFolder (GXL-FILE-GETFOLDER "选择替换文件夹"))
  (setq DwgList (VL-DIRECTORY-FILES strFolder "*.dwg" kd))
  (if DwgList
    (progn
      (setq n 0)
      (princ "\n  正在查找替换文本，请等待...")
      (princ)
      (foreach dwg DwgList
 (setq n (+ n (gxl-DBX-ReplaceText TextList (strcat strFolder "\"  dwg) 1)))
 )
      )
    )
  (princ (strcat "\n  共完成 " (itoa n) " 处文本替换！"))
  (princ)
  )

357785513 · 发表于 2010-7-30 12:16:00

看来二楼楼主得修一下,用后发现提示以下:

继续输入替换文字[Yes/No]<Yes>:n
替换方式[仅替换文本<0>/仅替换块中文本<1>/全部替换<2>]仅替换文本<0>:1
ucs
当前 UCS 名称: *世界*
指定 UCS 的原点或 [面(F)/命名(NA)/对象(OB)/上一个(P)/视图(V)/世界(W)/X/Y/Z/Z 轴(ZA)] <世界>: p
没有保存的上一个坐标系。
; 错误: *error* 函数中出错函数被取消

Gu_xl · 发表于 2010-8-3 12:28:00

357785513发表于2010-7-30 12:16:00看来二楼楼主得修一下,用后发现提示以下: 继续输入替换文字<Yes>:n替换方式仅替换文本<0>:1ucs当前 UCS 名称: *世界*指定 UCS 的原点或 <世界>: p没有保存的上一个

没有发现这种情况！能仔细说说或把图发上来看看！2004以下版本调试正确！

zhuoxiaoxin · 发表于 2010-8-3 12:35:00

G不错不错,.好程序,很成功

自贡黄明儒 · 发表于 2010-9-19 21:56:00

Gu_xl,你太牛了.

我遇到一个问题,想为选定的部分块更名,你有办法吗?请指教.

账号		自动登录	找回密码
密码			注册