lisp2arx
Visual Programming for AutoLisp
Mathématiques en programmation Lisp..
doc2cpp,doc2lsp, sld2lsp, bmp2dcl,
free__GifCcapture for all-CAD'platforms..
|
Nou pe simpatie:
pysy_mik pe Simpatie.ro
 | Femeie
25 ani
Teleorman
cauta Barbat
25 - 44 ani |
|
|
lisp2arxReguliInregistrareLoginPozeNu sunteti logat. Lista Forumurilor Pe Tematici
|
| #1 |
|
|
;;;----------------------------------------------------------------------------
;;; USAGE
;;;----------------------------------------------------------------------------
;;;
;;; (MakeZip "source filename with path" "destination file.zip* with path" *must not exist
;;; (MakeEmptyZip "destination file.zip* with path" *must not exist
;;; (Add2Zip "source filename with path" "destination file.zip* with path" *must exist
;;; (AddFolder2Zip "source path" "destination file.zip* with path" *must not exist
;;; (ExtractFilesFromZip "source file.zip with path" "source file in file.zip" "destination path"
;;; (ExtractAllFilesFromZip "source file.zip with path" "destination path"
;;; (GetAllFilesInZip "source file.zip with path" returns a list of all files in the zip file
;;;
;;;----------------------------------------------------------------------------
Code:
(vl-load-com)
(defun MakeZip (srcFile destFile)
(MakeEmptyZip destFile)
(Add2Zip srcFile destFile)
)
(defun MakeEmptyZip (destFile / fso fo)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(setq fo (vlax-invoke fso 'OpenTextFile destFile '2 'true))
(vlax-invoke fo 'Write (strcat (chr 80)(chr 75)(chr 5)(chr 6)))
(repeat 18 (vlax-invoke fo 'Write (chr 256)))
(vlax-invoke fo 'Close)
(vlax-release-object fo)
(vlax-release-object fso)
) |
;;; ZipUtils.lsp
;;; Copyright c2009 by K.E. Blackie
;;;
;;; http://www.resourcecad.com
;;;
;;;
;;; AutoCAD 2000+ VisualLISP
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;
;;;
;;;
;;;
Code:
(defun Add2Zip (srcFile destFile / app folder)
(setq app (vlax-create-object "Shell.Application"))
(setq folder (vlax-invoke app 'NameSpace destFile))
(vlax-invoke folder 'CopyHere srcFile)
(vlax-release-object folder)
(vlax-release-object app)
)
(defun AddFolder2Zip (srcFolder destFile)
(MakeEmptyZip destFile)
(setq app (vlax-create-object "Shell.Application"))
(setq folder (vlax-invoke app 'NameSpace srcFolder))
(setq destZip (vlax-invoke app 'NameSpace destFile))
(setq files (vlax-invoke folder 'Items))
(setq count (vlax-get-property files 'Count))
(setq ndx 0)
(repeat count
(setq file (vlax-invoke files 'Item ndx))
(vlax-invoke destZip 'CopyHere file)
(setq ndx (1+ ndx))
)
) |
Code:
(defun ExtractFileFromZip (zipFile srcName strDest / folder fso)
(if (member srcName (GetAllFilesInZip zipfile))
(progn
(setq fso (vlax-create-object "Shell.Application"))
(setq folder (vlax-invoke fso 'NameSpace strDest))
(vlax-invoke folder 'CopyHere (strcat zipFile "\\" srcName))
(vlax-release-object folder)
(vlax-release-object fso)
)
)
)
(defun ExtractAllFilesFromZip (zipFile strDest / folder fso)
(setq filelist (GetAllFilesInZip zipfile))
(setq fso (vlax-create-object "Shell.Application"))
(setq folder (vlax-invoke fso 'NameSpace strDest))
(setq ndx 0)
(repeat (length filelist)
(vlax-invoke folder 'CopyHere (strcat zipFile "\\" (nth ndx filelist)))
(setq ndx (1+ ndx))
)
(vlax-release-object folder)
(vlax-release-object fso)
)
(defun GetAllFilesInZip (zipFile / count file filelist files folder fso ndx path)
(setq path (car (fnsplitl zipFile)))
(setq fso (vlax-create-object "Shell.Application"))
(setq folder (vlax-invoke fso 'NameSpace zipFile))
(setq files (vlax-invoke folder 'Items))
(setq count (vlax-get-property files 'Count))
(setq ndx 0)
(repeat count
(setq file (vlax-invoke files 'Item ndx))
(setq filelist (append filelist (list (vlax-get-property file 'Name ))))
(setq ndx (1+ ndx))
)
filelist
) |
;;;----------------------------------------------------------------------------
;;; DESCRIPTION
;;;----------------------------------------------------------------------------
;;;
;;; This program uses VisualLISP and scripting objects to create,
;;; presumed the user will ensure the proper parameters are passed to each
;;; function to obtain the desired results.
_______________________________________
psw: cea de la wjndowsXP gigabyte..
|
|
| |
|
