[LISP程序]：不用打开dwg，可以查找文件中是否包含某个文字

brainstorm

;;;;在2000下注册objectdbx
(defun REGISTEROBJECTDBX (/ DBXSERVER )        ;by Tony Tanzillo
    (cond
        ((vl-registry-read
             "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
         )
        )
        ((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"
             )
             (alert
                 "Error: Failed to register ObjectDBX ActiveX services."
             )
         )
        )
    )
)
(defun c:findtextindwg (/ path filelst app mspace lst myerr olderr keystr docs filelst1)
   ;;;以下为秋枫的选择目录函数，可以到明经通道下载
    (setq path          (qf_getfolder "请选择目录:")
          filelst (vl-directory-files path "*.dwg" 1)
          filelst (mapcar '(lambda (x)
                               (strcat path "\\" x)
                           )
                          filelst
                  )
          lst          nil
          filelst1 nil
          keystr  (getstring "\n请输入关键字:")
    )
    (setq olderr *error*)
    (defun myerr (msg)
        (foreach n (list app DBXDOC mspace)
            (if        n
                (vlax-release-object n)
            )
        )
        (setq *error* nil)
        (princ "\n函数取消......")
        (princ)
    )
    (setq *error* myerr)
    (setq app (vlax-get-acad-object))
    (setq docs (vla-get-documents app))
    (vlax-for each docs (setq filelst1 (cons (vla-get-fullname each) filelst1)))
    ;;;返回dbxdoc
    (if        (= "15" (substr (getvar "acadver") 1 2))
        (progn
            (if        (not (REGISTEROBJECTDBX))
                (exit)
            )
            (setq
                DBXDOC
                   (vla-getinterfaceobject APP
                                           "ObjectDBX.AxDbDocument"
                   )
            )
        )
        (setq
            DBXDOC
               (vla-getinterfaceobject APP
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (substr (getvar "acadver")
                                                       1
                                                       2
                                               )
                                       )
               )
        )
    )
    (princ "\n正在处理... ...")
    (princ)
    (foreach n filelst
        (progn
            (if        (member n filelst1)
                (setq
                    mspace (vla-get-modelspace
                               (vla-item
                                   docs
                                   (vl-string-subst ""
                                                    (strcat path "\\")
                                                    n
                                   )
                               )
                           )
                )
                (progn
                    (vla-open DBXDOC n)
                    (setq mspace (vla-get-modelspace DBXDOC))
                )
            )
            (vlax-for each mspace
                (cond
                    ((and (wcmatch (vla-get-objectname each) "AcDbText,AcDbMText")
                          (wcmatch (vla-get-textstring each) keystr)
                     )
                     (if (not (member n lst))
                         (setq lst (cons n lst))
                     )
                    )
                )
            )
        )                                ;progn
    )                                        ;foreach n
    (if        (> (length lst) 0)
        (progn
            (setq lst (vl-sort  lst '<))
            (foreach n lst
                (princ (strcat "\n在"                  n
                               "文件中,有你要找的文字 \""
                               keystr                  "\"."
                              )
                )
            )
        )
        (princ "\n没有符合条件的文件!")
    )
    (foreach n (list app DBXDOC mspace)
        (if n
            (vlax-release-object n)
        )
    )
    (textscr)
    (princ)
)

zml84

不是不打开，只是不用手工打开。

雨箭风刀

关键：调用dbx
可以用vbs vb vc...等