VLISP目录，文件操作函数

Lisphk · 发表于 2016-9-10 17:56:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

VLISP目录，文件操作函数

(defun GetFolder (/ Dir Item Path)
(cond
((setq Dir (vlax-invoke
(vlax-get-or-create-object "Shell.Application")
'browseforfolder
0
"Select folder with DWG files:"
1
""
)
)
(cond
((not
(vl-catch-all-error-p
(vl-catch-all-apply 'vlax-invoke-method (list Dir 'Items))
)
)
(setq Item (vlax-invoke-method
(vlax-invoke-method Dir 'Items)
'Item
)
)
(setq Path (vla-get-path Item))
(if
(not (member (substr Path (strlen Path) 1) (list "/" "\\")))
(setq Path (strcat Path "\\"))
) ;end if
)
) ;end cond
)
) ;end cond
Path
) ;end GetFolder
(defun vl-findfile (Location / DirList Path AllPath)
(MakeDirList Location)
(setq DirList (cons Location DirList))
(foreach Elem DirList
(if (setq Path (vl-directory-files Elem "*.dwg"))
(foreach Item Path
(setq AllPath (cons (strcat Elem "/" Item) AllPath))
)
) ;end if
)
(reverse AllPath)
) ;end vl-findfile
(defun MakeDirList (Arg / TmpList)
(setq TmpList (cddr (vl-directory-files Arg nil -1)))
(cond
(TmpList
(setq
DirList (append
DirList
(mapcar '(lambda (z) (strcat Arg "/" z)) TmpList)
)
)
(foreach Item TmpList (MakeDirList (strcat Arg "/" Item)))
)
) ;end cond
) ;end MakeDirList

(defun GetFolder (/ Dir Item Path) 
    (cond 
      ((setq Dir (vlax-invoke 
                   (vlax-get-or-create-object "Shell.Application") 
                   'browseforfolder 
                   0 
                   "Select folder with DWG files:" 
                   1 
                   "" 
                 ) 
       ) 
       (cond 
         ((not 
            (vl-catch-all-error-p 
              (vl-catch-all-apply 'vlax-invoke-method (list Dir 'Items)) 
            ) 
          ) 
          (setq        Item (vlax-invoke-method 
                       (vlax-invoke-method Dir 'Items) 
                       'Item 
                     ) 
          ) 
          (setq Path (vla-get-path Item)) 
          (if 
            (not (member (substr Path (strlen Path) 1) (list "/" "\\"))) 
             (setq Path (strcat Path "\\")) 
          )                                ;end if 
         ) 
       )                                ;end cond 
      ) 
    )                                        ;end cond 
    Path 
  )                                        ;end GetFolder 
 
  (defun vl-findfile (Location / DirList Path AllPath) 
    (MakeDirList Location) 
    (setq DirList (cons Location DirList)) 
    (foreach Elem DirList 
      (if (setq Path (vl-directory-files Elem "*.dwg")) 
        (foreach Item Path 
          (setq AllPath (cons (strcat Elem "/" Item) AllPath)) 
        ) 
      )                                        ;end if 
    ) 
    (reverse AllPath) 
  )                                        ;end vl-findfile 
  (defun MakeDirList (Arg / TmpList) 
    (setq TmpList (cddr (vl-directory-files Arg nil -1))) 
    (cond 
      (TmpList 
       (setq 
         DirList (append 
                   DirList 
                   (mapcar '(lambda (z) (strcat Arg "/" z)) TmpList) 
                 ) 
       ) 
       (foreach Item TmpList (MakeDirList (strcat Arg "/" Item))) 
      ) 
    )                                        ;end cond 
  )                                        ;end MakeDirList

下面命令是上面几个函数的组合应用，获取一个目录下（可以包括子目录，有选项）的所有DWG文件列表并返回。

[it618postdisplay>0]

(defun c:tt ()
(setq dwgpath (getfolder))
(initget "Yes No")
(setq subdir (cond
((getkword "\nLooking for subfolders? No,[Yes]: "))
(t
"Yes"
)
)
)
(if (equal subdir "Yes")
(setq files (vl-findfile (substr dwgpath 1 (1- (strlen dwgpath)))))
(setq files (mapcar
'(lambda (x)
(strcat dwgpath x)
)
(vl-directory-files dwgpath "*.dwg" 1)
)
)
)
)

[/it618postdisplay]

("C:\\Program Files (x86)\\AutoCAD 2008\\Sample\\3D House.dwg" "C:\\Program
Files (x86)\\AutoCAD 2008\\Sample\\Architectural - Annotation Scaling and
Multileaders.dwg" "C:\\Program Files (x86)\\AutoCAD 2008\\Sample\\Blocks and
Tables - Imperial.dwg" "C:\\Program Files (x86)\\AutoCAD 2008\\Sample\\Blocks
and Tables - Metric.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\colorwh.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\db_samp.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\Lineweights.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\Plot Screening and Fill Patterns.dwg" "C:\\Program Files
(x86)\\AutoCAD 2008\\Sample\\Tablet.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\TrueType.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\Visualization - Aerial.dwg" "C:\\Program Files (x86)\\AutoCAD
2008\\Sample\\Visualization - Condominium with Skylight.dwg" "C:\\Program Files
(x86)\\AutoCAD 2008\\Sample\\Visualization - Conference Room.dwg" "C:\\Program
Files (x86)\\AutoCAD 2008\\Sample\\Visualization - Sun and Sky Demo.dwg")

HLCAD · 发表于 2016-9-10 18:12:04

非常实用程序，感谢楼主分享

yoyoho · 发表于 2016-9-10 18:31:38

感谢楼主分享,回覆学习!!!!!

q3_2006 · 发表于 2016-9-10 18:50:38

最近都在收代码..楼大爆发了呀...

marting · 发表于 2016-9-10 20:24:41

谢谢楼主，很实用的一个代码。

ynhh · 发表于 2016-9-10 21:43:22

感谢楼主分享,回覆学习!!!!!感谢楼主分享,回覆学习!!!!!

ynhh · 发表于 2016-9-10 21:44:29

感谢楼主分享,回覆学习!!!!!感谢楼主分享,回覆学习!!!!!

e网浪人 · 发表于 2016-9-10 22:40:40

谢谢楼主分享，学习。

lucas3 · 发表于 2016-9-10 23:48:20

谢谢楼主分享，学习。

sicky111 · 发表于 2016-9-11 10:24:02

很给力，谢谢楼主。

yjch · 发表于 2016-9-13 16:54:17

好好学习天天向上，手段好丰富

gooday · 发表于 2016-12-29 17:10:54

啥也不说了，感谢楼主分享哇！

dnbcgrass · 发表于 2016-12-29 19:57:16

回复学习学习！

flydyt · 发表于 2016-12-29 21:31:43

谢谢分享，学习一下

819534890 · 发表于 2016-12-30 09:28:00

回复学习收藏谢谢分享

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

[每日一码] VLISP目录，文件操作函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。