还记得给你写的替换文字的程序吗,这里改装了一点点,将替换文字部分变成操作文字类型操作。我只给你做到ChgStyle函数,这里只找出了所有的文字类型,并打印,但未做任何修改,修改部分你自己做吧,同ActiveX方法一样做就可以了。注:用过后的文件将没有预览图片了- (vl-load-com)
- (defun qf_getFolder (msg / WinShell shFolder path catchit)
- (vl-load-com)
- (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
- )
- )(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 ChgStyle (DBXDOCX DwgName Flags / txtstyles txtstyle)
- (if Flags
- (vla-open DBXDOCX DwgName)
- )
- (setq txtstyles (vla-get-textstyles DBXDOCX))
- (vlax-for txtstyle txtstyles
- (princ "\n")
- (princ (vla-get-name txtstyle))
- )
- )(defun TextMain(APP DOC DwgName / App DOC DBXDOC NAME1) (if (= "15" (substr (getvar "acadver") 1 2))
- (progn
- (if (not (REGISTEROBJECTDBX))
- (exit)
- )
- (setq
- DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")
- )
- )
- (setq
- DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument.16")
- )
- )
- (setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))
- ;(vlax-dump-object DBXDOC T)
- (if (= NAME1 DwgName)
- (progn (ChgStyle DOC DwgName nil)) (vla-save DOC))
- (progn (ChgStyle DBXDOC DwgName t)) (vlax-invoke-method DBXDOC 'SAVEAS DWGNAME));APP DBXDOC DwgName))
- )
- (vlax-release-object DBXDOC)
- )(defun C:main( / APP DOC path files file)
- (setq APP (vlax-get-acad-object))
- (setq DOC (vla-get-activedocument APP))
- (setq path (qf_getFolder "选择目录..."))
- (if path
- (progn
- (setq files (vl-directory-files path "*.dwg" 1))
- (foreach file files
- (TextMain app doc (strcat path "\" file))
- (princ (strcat path "\" file "替换完成了\n"))
- )
- (vlax-release-object DOC)
- (vlax-release-object APP)
- )
- )
- (princ)
- )
|