分解vlx

nzl1116 · 发表于 2014-8-24 19:14:39

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

(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)

(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)

baitang36 · 发表于 2021-12-2 12:29:08

KO你发表于 2020-3-28 20:52
多个vlx要怎么合并呢

http://bbs.mjtd.com/thread-182915-1-1.html

KO你 · 发表于 2020-3-28 20:52:21

KO你发表于 2020-3-27 21:02
楼主，有没有把多个lisp文件合并成一个vlx的程序

多个vlx要怎么合并呢

cable2004 · 发表于 2014-8-24 19:53:12

顶起。。。。。。。。。。

lucas_3333 · 发表于 2014-8-24 19:55:30

楼主分享的精神可嘉，只是可能会激怒一些人吧！
总之我还是挺你的！
这个应改是分解vlx成FAS吧，只是拿了几个VLX试了下，没有一个成功的。
73208; 错误: 列表中有字符代码错误: 18006
180880; 错误: 列表中有字符代码错误: 18006

nzl1116 · 发表于 2014-8-24 20:05:18

lucas_3333 发表于 2014-8-24 19:55
楼主分享的精神可嘉，只是可能会激怒一些人吧！
总之我还是挺你的！
这个应改是分解vlx成FAS吧，只是拿了 ...

我一直以来用的都是2004，高版本好象是不行。

恕放之生命 · 发表于 2014-8-24 20:53:36

本帖最后由恕放之生命于 2014-9-5 09:01 编辑

太强大了，居然测试成功了。带对话框的也可以还原成dcl.

恕放之生命 · 发表于 2014-8-24 20:55:35

比用winhex方便多了。

love1030312 · 发表于 2014-8-24 21:12:40

支持顶起有些能成功有些失败还是很给力的

彳余 · 发表于 2014-8-24 21:13:52

太强大了，居然测试成功了。

smartstar · 发表于 2014-8-24 21:57:16

牛人真是太多了，膜拜ing！

邹锋 · 发表于 2014-8-24 23:19:51

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

[源码] 分解vlx

点评

评分

点评

浏览过的版块