分解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)
(setqarrayspace (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)
(setqs 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)
(repeat4
(setqTmpLst (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)

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

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

多个vlx要怎么合并呢

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

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

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

baitang36 发表于 2021-12-2 12:28:27

2548572928 发表于 2021-12-2 11:54
下载了赞一个

试试能用了再点赞比较好

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 static/image/common/back.gif
楼主分享的精神可嘉，只是可能会激怒一些人吧！
总之我还是挺你的！
这个应改是分解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

页: [1] 2 3 4 5 6 7 8

明经CAD社区's Archiver

分解vlx