lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms.. 		Lista Forumurilor Pe Tematici
lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat. 		Nou pe simpatie:
DEEA25 pe Simpatie
Femeie
25 ani
Mures
cauta Barbat
25 - 51 ani
lisp2arx / CL_aclayer.lisp / VLisp -How to zip and unzip files directly within AutoCAD, Moderat de zauchan
Autor
Mesaj Pagini: 1
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180
;;;----------------------------------------------------------------------------
;;;   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
;;;
;;; 
;;;   
;;;
;;;   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..
pus acum 3 ani
   
Pagini: 1  

Mergi la