本帖最后由 nzl1116 于 2015-4-30 02:41 编辑

[code="lisp]

(vl-load-com)

(defun AYL-binary (Import / AdoObj BytLst)

(if (setq AdoObj (Vlax-Get-Or-Create-Object "ADODB.Stream"))

(progn

(Vlax-Put-Property AdoObj 'Type 1)

(Vlax-Invoke AdoObj 'Open)

(Vlax-Invoke-Method AdoObj 'LoadFromFile Import)

(Vlax-Put-Property AdoObj 'Position 0)

(setq BytLst (Vlax-Invoke-Method AdoObj 'Read (Vlax-Get-Property AdoObj 'Size)))

(Vlax-Invoke-Method AdoObj 'Close)

(vlax-release-object AdoObj)

(vlax-safearray->list (vlax-variant-value BytLst))

)

)

)

(defun AYL-list->variant (ptsList / arrayspace sArray)

(setq  arrayspace (vlax-make-safearray 17 (cons 0 (1- (length ptsList))))

sArray     (vlax-safearray-fill arrayspace ptsList)

)

(vlax-make-variant sArray)

)

(defun AYL-write-binary (Export DatLst / AdoObj)

(if (setq AdoObj (Vlax-Get-Or-Create-Object "ADODB.Stream"))

(progn

(Vlax-Put-Property AdoObj 'Type 1)

(Vlax-Invoke AdoObj 'Open)

(Vlax-Put-Property AdoObj 'Position 0)

(Vlax-Invoke-Method AdoObj 'Write (AYL-list->variant DatLst))

(vl-file-delete Export)

(Vlax-Invoke AdoObj 'SaveToFile Export 1)

(Vlax-Invoke-Method AdoObj 'Close)

(princ (strcat "\n成功创建 " Export " 文件!"))

(vlax-release-object AdoObj)

)

)

)

(defun AYL-E->D  (ELst / n s e)

(setq  s 0)

(while (= (car ELst) 0)

(setq ELst (cdr ELst))

)

(if (< 0 (setq n (length ELst)) 5)

(foreach Item ELst

(setq n (1- n)

e (expt 256 n)

s (+ s (* Item e))

)

)

)

s

)

(defun AYL-null (TmpLst)

(princ)

)

(defun AYL-Umvlx (Import / BytLst TmpLst Number Int0 Int1 Int2 Int3 Fname Export)

(if (setq BytLst (AYL-binary Import))

(progn

(setq TmpLst nil Number (length BytLst))

(princ "\n文件大小：")

(princ Number)

;;提取前8个字节 VRTLIB-1

(repeat 8

(setq TmpLst (cons (car BytLst) TmpLst)

BytLst (cdr BytLst)

)

)

(if (= (vl-list->string (reverse TmpLst)) "VRTLIB-1")

(setq TmpLst nil)

(progn (princ "\n无效的vlx文件") (VL-EXIT-WITH-VALUE ""))

)

;;提取4个字节，这四个字节表示的整数指除最后16个字节外的所有字节的总数，包括开头的八个字节

(repeat 4

(setq TmpLst (cons (car BytLst) TmpLst)

BytLst (cdr BytLst)

)

)

(setq Int0 (- (AYL-E->D TmpLst) 12) TmpLst nil)

(while (> (rem Int0 4) 0) (setq Int0 (1+ Int0)))

(setq Fname (substr Import 1 (- (strlen Import) 4 (strlen (vl-filename-base Import)))))

(while (> Int0 6)

(setq TmpLst nil Export Fname)

(repeat  4

(setq  TmpLst (cons (car BytLst) TmpLst)

BytLst (cdr BytLst)

)

)

(setq Number (AYL-E->D TmpLst))

(while (> (rem Number 4) 0) (setq Number (1+ Number)))

(setq Int0   (- Int0 Number)

Int1   (car BytLst)

Int2   (cadr BytLst)

Int3   (caddr BytLst)

BytLst (cdddr BytLst)

)

(if (and (member Int1 '(50 55 70 216 0)) (member Int2 '(0 4 5)))

(progn

(setq TmpLst nil Number (- Number 7 Int3))

(repeat Int3

(setq TmpLst (cons (car BytLst) TmpLst)

BytLst (cdr BytLst)

)

)

(setq Export (strcat Export (vl-list->string (reverse TmpLst))))

(setq TmpLst nil)

(if (> Number 0)

(repeat Number

(setq TmpLst (cons (car BytLst) TmpLst)

BytLst (cdr BytLst)

)

)

)

(while (= (car TmpLst) 0) (setq TmpLst (cdr TmpLst)))

(setq TmpLst (reverse TmpLst))

(cond

((= Int1 216)

(if (= Int2 4)

(AYL-null TmpLst)

(progn (princ "文件信息错误") (VL-EXIT-WITH-VALUE ""))

)

)

((= Int1 50)

(if (/= Int2 5) (progn (princ "文件类型错误50") (VL-EXIT-WITH-VALUE "")))

(setq Export (strcat Export ".fas"))

(if TmpLst

(progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))

(close (open Export "w"))

)

)

((= Int1 0)

(if (/= Int2 0) (progn (princ "文件类型错误0") (VL-EXIT-WITH-VALUE "")))

(princ "\n这个类型的文件要根据实际情况更改后缀名")

(setq Export (strcat Export ".ayl"))

(if TmpLst

(progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))

(close (open Export "w"))

)

)

((= Int1 55)

(if (/= Int2 5) (progn (princ "文件类型错误55") (VL-EXIT-WITH-VALUE "")))

(setq Export (strcat Export ".txt"))

(if TmpLst

(progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))

(close (open Export "w"))

)

)

((= Int1 70)

(if (/= Int2 5) (progn (princ "文件类型错误70") (VL-EXIT-WITH-VALUE "")))

(setq Export (strcat Export ".dcl"))

(if TmpLst

(progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))

(close (open Export "w"))

)

)

(t (princ "文件类型错误") (VL-EXIT-WITH-VALUE ""))

)

)

(progn (princ "文件类型错误") (VL-EXIT-WITH-VALUE ""))

) ;_ end if

) ;_ end while

(princ "\n")

) ;_ end progn

) ;_ end if

)

(defun c:Umvlx (/ file)

(if (setq file (getfiled "" "" "vlx" 0))

(AYL-Umvlx file)

)

(princ)

)

(princ "\n命令名： Umvlx")

(princ "  作者：晨语  QQ：1024045011")

(princ)[/code]