<A name=14686><FONT color=#990000><B>myfreemind</B></FONT></A>兄，我的图中内容本来就不多，而有那么大，肯定有很多无用的东东，你的图中对象是不是很多？可能就减不小吧。个人观点。呵呵……
meflying发表于2004-4-25 19:31:00static/image/common/back.gif把一切打开图形需要加载的东西都去掉,可能会快些,,,用ACTIVEX是自动完成的,
飞哥，我还不是太清楚打开图形需要加载哪些东西，是不是我自己的其它程序（及其它三方程序）也可先不加载呀？
这个不重要,重要的是你先把程序写出来
飞哥，帮我看看这个程序，是在你的程序基础上改的，在 (vla-open DOC (strcat path "\\" file))时不对，打不开，谢谢了！！！(defun VxMakeDirectory
(Dir / CurDir DrvObj FilSys RetVal TmpLst TmpVal)
(setqFilSys (vlax-create-object "Scripting.FileSystemObject")
CurDir (vl-string-right-trim "\\" (vl-string-right-trim "/" Dir))
)
(while (/= (setq TmpVal (vl-filename-directory CurDir)) CurDir)
(setq TmpLst (cons TmpVal TmpLst)
CurDir TmpVal
)
)
(setq
RetVal (cond
((= (vlax-invoke FilSys "DriveExists" TmpVal) 0) nil)
((setq DrvObj (vlax-invoke FilSys "GetDrive" TmpVal))
(cond
((= (vlax-get DrvObj "IsReady") 0) nil)
(T
(foreach memb TmpLst
(cond
((= (vlax-invoke FilSys "FolderExists" memb) -1))
((vlax-invoke FilSys "CreateFolder" memb))
)
)
(cond
((= (vlax-invoke FilSys "FolderExists" Dir) -1))
((vlax-invoke FilSys "CreateFolder" Dir) T)
(T nil)
)
)
)
)
)
)
(if DrvObj
(vlax-release-object DrvObj)
)
(vlax-release-object FilSys)
RetVal
)
(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 findpath()
(setq path (qf_getFolder "请选择目录..."))
(setq files (vl-directory-files path "*.dwg" 1))
(if (not files)
(alert "所选目录无 .dwg 文件！请重新选择——")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;main
(vl-load-com)
(defun err (msg)
(setq *error* errtmp)
(vlax-release-object DOC)
(vlax-release-object APP)
(princ)
)
(defun C:kr_purge (/ APP DOC files file
newpath dcl_id dd NAME
OLDVAR-FILEDIA PATH
)
(setq errtmp *error*)
(setq *error* err)
(setq APP (vlax-get-acad-object))
(setq DOC (vla-get-ActiveDocument APP))
(setq dcl_id (load_dialog "kr_pur.DCL"))
(if (not (new_dialog "kr_pur" dcl_id))
(exit)
)
(action_tile
"krbrowse"
"(findpath) (set_tile \"path\" path)"
)
(action_tile "accept" "(done_dialog 1)")
(setq dd (start_dialog))
(if (= dd 1)
(progn
(if files
(progn
(setq newpath (strcat path "\\减肥后的"))
(VxMakeDirectory newpath)
(foreach filefiles
(vla-open DOC (strcat path "\\" file))
(setvar "cmdecho" 0)
(setq oldvar-filedia (getvar "filedia"))
(setvar "filedia" 0)
(setq name (getvar "dwgname"))
(vl-cmdf "export" (strcat newpath "\\" name))
(setvar "filedia" oldvar-filedia)
(vla-Close DOC flase file)
)
;;;(princ (strcat path "\\" file " 减肥成功完成了\n"))
)
)
(alert "所选目录无 .dwg 文件！本程序将退出！")
)
)
(unload_dialog dcl_id)
(vlax-release-object DOC)
(vlax-release-object APP)
(princ)
)
kr_pur:dialog{label="批量减肥 ";
spacer;
:text {
label = "下面的文件夹内的所有.dwg文件均会进行减肥：";
fixed_width = true;
alignment = centered;
}
spacer;
:row{
:edit_box {key="path";}
:button{label="......";fixed_width = true;alignment = centered;key="krbrowse";}
}
spacer;
: row { // 定义 OK/Cancel 按钮行
: spacer { width = 1; }
: button { // 定义 OK 按钮
label = "开始批量减肥";
is_default = true;
key = "accept";
width = 8;
fixed_width = true;
}
: button { // 定义 Cancel 按钮
label = "退出本小程序";
is_cancel = true;
key = "cancel";
width = 8;
fixed_width = true;
}
: spacer { width = 1;} }
}
都不在呀
(foreach FILE FILES<BR> (setq WW (vla-open DOC (strcat PATH "\\" FILE))) ;By LUCAS
;|---------------你這段是操作目前圖檔-------------------<BR> ;;-----------------操作WW要用ActiveX--------------------<BR> (setvar "cmdecho" 0)<BR> (setq OLDVAR-FILEDIA (getvar "filedia"))<BR> (setvar "filedia" 0)<BR> (setq NAME (getvar "dwgname"))<BR> (vl-cmdf "export" (strcat NEWPATH "\\" NAME))<BR> (setvar "filedia" OLDVAR-FILEDIA)<BR> ;;------------------------------------------------------<BR> |;
(vla-close WW :vlax-false) ; By LUCAS<BR> )
龙兄，谢谢！
我把你的那段代码COPY过来用了一下，好像还是打不开文档，你再帮忙看看，谢谢了！！！
(setq APP (vlax-get-acad-object))<BR> (setq DOC (vla-get-documents APP)) ;By LUCAS<BR> ;;(vla-get-activedocument APP)) <BR> ;;activedocument ->是作用中圖檔,要對圖檔集合(documents)操作
谢谢龙兄！！！
文档打开了！
但(setq NAME (getvar "dwgname"))返回的是我最先打开的文档名，不是(setq WW (vla-open DOC (strcat PATH "\\" FILE))) 打开的FILE的文档名，并且WW没有激活，不是当前活动文档。<BR>