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

qqyspgj

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

请帮忙给予协助，本人是菜鸟！
以下贴入“Gu_xl"版主博客的文件代码

;;;(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
        (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/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)
  )

执行到这步“ (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

删除注释标记再测试

qqyspgj

感谢，回头试下

qqyspgj

还是不行，出现错误

qqyspgj

;;;( FR 源文本 目标文本 文件名) 利用ObjectDBX技术不打开DWG文件替换文本
(defun gxl-DBX-ReplaceText (SourceText     TargetText
                            DwgName        /
                            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 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

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

树櫴希德

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