求助“Gu_xl"版主的一个”利用ObjectDBX技术不打开DWG文件替换文本“

qqyspgj 发表于 2018-9-25 12:52:53

本帖最后由 qqyspgj 于 2018-9-25 12:55 编辑

因本人级别低，无法留言班主：在班主的博客上看到一个”利用ObjectDBX技术不打开DWG文件替换文本“的文章，我下载后执行不了！

请帮忙给予协助，本人是菜鸟！
以下贴入“Gu_xl"版主博客的文件代码
;;;(gxl-DBX-ReplaceText '((源文本 . 目标文本)...) 文件名替换方式) 利用ObjectDBX技术不打开DWG文件替换文本,Flag 0 仅替换文字 1 仅替换块中文字 2 全部替换
(defun gxl-DBX-ReplaceText (TextList;SourceText TargetText
   DwgName Flag /
   RegObjectDBX
   DBXModelSpaceDBXDOC
   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
   (if (not (WCMATCH (vla-get-name block) "*_Space*"))
   (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
   (if (not (WCMATCH (vla-get-name block) "*_Space*"))
   (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)
)
   (if (not (equal DBXDOC *ACDOCUMENT*))(vlax-release-object DBXDOC))
   count
) ;_ progn
) ;_ if
) ;_ defun;;;使用函数
(defun c:gxl-RePlaceText1 (/ 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>:"))
(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>:"))
(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)
)

执行到这步“ (setq strFolder (GXL-FILE-GETFOLDER "选择替换文件夹"))”提示“; 错误: no function definition: GXL-FILE-GETFOLDER”尝试了给它赋值;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
(defun gxl-file-GetFolder (msg / WinShell shFolder path catchit)(setq winshell (vlax-create-object "Shell.Application"))(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))(setq catchit (vl-catch-all-apply          '(lambda ()             (setq shFolder (vlax-get-property shFolder 'self))             (setq path (vlax-get-property shFolder 'path))             )          ))(if (vl-catch-all-error-p catchit) nil path))执行到选择替换的文件夹后，cad“2002/2019”都又提示“替换方式[仅替换文本<0>/仅替换块中文本<1>/全部替换<2>]仅替换文本<0>:正在查找替换文本，请等待...; 错误: 参数类型错误: VLA-OBJECT nil”请哪位大侠给解惑下。请"gu_xl“版主勿怪，原文件博客地址”http://gyh060707.blog.sohu.com/164581411.html“

xtjd 发表于 2019-7-11 15:20:22

删除注释标记再测试

qqyspgj 发表于 2019-7-11 23:40:12

感谢，回头试下

qqyspgj 发表于 2019-7-12 11:08:35

还是不行，出现错误

qqyspgj 发表于 2019-7-12 11:17:43

;;;( FR 源文本目标文本文件名) 利用ObjectDBX技术不打开DWG文件替换文本
(defun gxl-DBX-ReplaceText (SourceText TargetText
                        DwgName    /
                        RegObjectDBX
                        DBXModelSpaceDBXDOC
                        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 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*) ;_ setq
   (progn (vla-open DBXDOC DWGNAME)
            (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
   ) ;_ progn
   ) ;_ if
   (setq count 0)
   ;(vlax-for    for-item DBXModelSpace
   ;(vlax-dump-object for-item)
   ;(foreach itemsff for-item
   ;(princ itemsff)
   ;)
   ;)
   (vlax-for obj DBXModelSpace
   (if (= "AcDbMText" (vla-get-ObjectName obj));此处根据文本类型修改成相应的字符串,多行文字为“AcDbMText”，单行文字为“AcDbText”
      (if (= SourceText (vla-Get-textString obj))
         (progn
         (vla-put-TextString obj TargetText)
         (setq count (1+ count))
         ) ;_ progn
      ) ;_ if
   ) ;_ if
   ) ;_ vlax-for
   (if (equal (strcase FileName) (strcase DWGNAME))
   (vla-Save *AcDocument*)
   (vla-Saveas DBXDOC DWGNAME)
   )
   (vlax-release-object DBXDOC)
   count
) ;_ progn
) ;_ if
) ;_ defun
(defun c:FR (/ source Target strFolder DwgList n)(vl-load-com)
(princ "n程序编制by Gu_xl,2010年7月")
(setq source (getstring "n输入源文字:"))
(setq Target (getstring "n输入要替换的文字:"))
(setq strFolder "D:/AutoCADlispTest4Find&Replace/dwgFile");根据实际情况修改此路径，即为需要查找替换的dwg文件所在的文件夹
(setq DwgList (VL-DIRECTORY-FILES strFolder "*.dwg" 1))
(if DwgList
(progn
   (setq n 0)
   (princ "n正在查找替换文本，请等待...")
   (princ)
   (foreach dwg DwgList
   (setq Pathhh (vl-string-translate "/" "" (strcat strFolder "/"dwg)))
   (setq n (+ n (gxl-DBX-ReplaceText source Target Pathhh)))
   (princ (strcat "n已完成 " Pathhh " 处文本替换"))
   (princ)
   )
   )
)
)
----------------------------------------------
这个别人修改的，不方便的就是手动需要修改要替换的文件路径

zhengfang31 发表于 2023-1-19 10:47:56

学习一下，很有参考价值，我想不打开cad修改变量值，正好用到

树櫴希德 发表于 2023-7-1 16:46:00

请问能不能不开图批量多段线转二维多段线？

页: [1]

明经CAD社区's Archiver

求助“Gu_xl"版主的一个”利用ObjectDBX技术不打开DWG文件替换文本“