Author Topic: ZIP files ZIP folders & VLISP  (Read 5653 times)

0 Members and 1 Guest are viewing this topic.

thanhduan2407

  • Mosquito
  • Posts: 5
Re: ZIP files ZIP folders & VLISP
« Reply #15 on: December 21, 2017, 10:03:47 AM »
Code: [Select]
(defun C:99 (/ DIRFILE1 FN1 NAMEFILE1 T1 TEN Z0 Z1)
  (setq Ten (getfiled "Select File" (getvar "dwgprefix") "*" 8))
  (setq fn1 (strcat (getvar "dwgprefix") Ten))
  (setq DirFile1 (vl-filename-directory fn1))
  (setq NameFile1 (vl-filename-base fn1))
  (setq t1 (strcat DirFile1 (chr 92) "doc.kml"))
  (vl-file-copy fn1 (strcat DirFile1 (chr 92) "doc.kml"))
  (setq Z0 (strcat DirFile1 (chr 92) "tempppppp111ggfssd.zip"))
  (MakeEmptyZip Z0)
  (if (/= (findfile t1) nil)
    (Add2Zip t1 Z0)
  )
  (wait 2.0)
  (setq Z1 (strcat DirFile1 (chr 92) NameFile1 "_.kmz"))
  (vl-file-copy
    Z0
    Z1
  )
  (if (/= (findfile fn1) nil)
    (vl-file-delete fn1)
  )
  (if (/= (findfile t1) nil)
    (vl-file-delete t1)
  )
  (if (/= (findfile Z0) nil)
    (vl-file-delete Z0)
  )
  (Princ)
)

(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 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)
)
;;(wait 0.01)
(defun wait (seconds / stop)
  (setq stop (+ (getvar "DATE") (/ seconds 86400.0)))
  (while (> stop (getvar "DATE")))
)



Lee Mac

  • Seagull
  • Posts: 12390
  • London, England
Re: ZIP files ZIP folders & VLISP
« Reply #16 on: December 21, 2017, 01:38:43 PM »