[讨论]关于上万张图怎样减肥好，on earth？

tukuitk · 发表于 2004-4-26 09:39:00

myfreemind兄，我的图中内容本来就不多，而有那么大，肯定有很多无用的东东，你的图中对象是不是很多？可能就减不小吧。个人观点。呵呵……

tukuitk · 发表于 2004-4-26 09:44:00

meflying发表于2004-4-25 19:31:00把一切打开图形需要加载的东西都去掉,可能会快些,,,用ACTIVEX是自动完成的,

飞哥，我还不是太清楚打开图形需要加载哪些东西，是不是我自己的其它程序（及其它三方程序）也可先不加载呀？

meflying · 发表于 2004-4-26 16:05:00

这个不重要,重要的是你先把程序写出来

tukuitk · 发表于 2004-4-27 16:17:00

飞哥，帮我看看这个程序，是在你的程序基础上改的，在 (vla-open DOC (strcat path "\\" file))时不对，打不开，谢谢了！！！

(defun VxMakeDirectory
(Dir / CurDir DrvObj FilSys RetVal TmpLst TmpVal)
(setq FilSys (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 file files
(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)
)

(defun VxMakeDirectory
             (Dir / CurDir DrvObj FilSys RetVal TmpLst TmpVal)
   (setq  FilSys (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 file  files
         (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)
)

tukuitk · 发表于 2004-4-27 16:18:00

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;} }
}

tukuitk · 发表于 2004-4-27 17:08:00

都不在呀

龙龙仔 · 发表于 2004-4-28 12:02:00

(foreach FILE FILES
(setq WW (vla-open DOC (strcat PATH "\\" FILE))) ;By LUCAS ;|---------------你這段是操作目前圖檔-------------------
;;-----------------操作WW要用ActiveX--------------------
(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 WW :vlax-false) ; By LUCAS
)

tukuitk · 发表于 2004-4-28 12:26:00

龙兄，谢谢！

我把你的那段代码COPY过来用了一下，好像还是打不开文档，你再帮忙看看，谢谢了！！！

龙龙仔 · 发表于 2004-4-29 11:35:00

(setq APP (vlax-get-acad-object))
(setq DOC (vla-get-documents APP)) ;By LUCAS
;;(vla-get-activedocument APP))
;;activedocument ->是作用中圖檔,要對圖檔集合(documents)操作

tukuitk · 发表于 2004-4-29 14:32:00

谢谢龙兄！！！文档打开了！但(setq NAME (getvar "dwgname"))返回的是我最先打开的文档名，不是(setq WW (vla-open DOC (strcat PATH "\\" FILE))) 打开的FILE的文档名，并且WW没有激活，不是当前活动文档。

账号		自动登录	找回密码
密码			注册