社区 › 源码共享 › 牢固的代码死循环

dcl1214 发表于 2012-7-30 15:41:03

牢固的代码死循环

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





这个是牢固的代码，使用时总是死循环，望各位高手帮忙看看！！

1993063 发表于 2012-8-1 12:27:01

本帖最后由 1993063 于 2012-7-31 18:39 编辑

(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 "no")
    (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)
)

查看完整版本: 牢固的代码死循环