明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 25365|回复: 94

[源码] 分解vlx

    [复制链接]
发表于 2014-8-24 19:14 | 显示全部楼层 |阅读模式
本帖最后由 nzl1116 于 2015-4-30 02:41 编辑
  1. (vl-load-com)

  2. (defun AYL-binary (Import / AdoObj BytLst)
  3.   (if (setq AdoObj (Vlax-Get-Or-Create-Object "ADODB.Stream"))
  4.     (progn
  5.       (Vlax-Put-Property AdoObj 'Type 1)
  6.       (Vlax-Invoke AdoObj 'Open)
  7.       (Vlax-Invoke-Method AdoObj 'LoadFromFile Import)
  8.       (Vlax-Put-Property AdoObj 'Position 0)
  9.       (setq BytLst (Vlax-Invoke-Method AdoObj 'Read (Vlax-Get-Property AdoObj 'Size)))
  10.       (Vlax-Invoke-Method AdoObj 'Close)
  11.       (vlax-release-object AdoObj)
  12.       (vlax-safearray->list (vlax-variant-value BytLst))
  13.     )
  14.   )
  15. )

  16. (defun AYL-list->variant (ptsList / arrayspace sArray)
  17.   (setq  arrayspace (vlax-make-safearray 17 (cons 0 (1- (length ptsList))))
  18.   sArray     (vlax-safearray-fill arrayspace ptsList)
  19.   )
  20.   (vlax-make-variant sArray)
  21. )

  22. (defun AYL-write-binary (Export DatLst / AdoObj)
  23.   (if (setq AdoObj (Vlax-Get-Or-Create-Object "ADODB.Stream"))
  24.     (progn
  25.       (Vlax-Put-Property AdoObj 'Type 1)
  26.       (Vlax-Invoke AdoObj 'Open)
  27.       (Vlax-Put-Property AdoObj 'Position 0)
  28.       (Vlax-Invoke-Method AdoObj 'Write (AYL-list->variant DatLst))
  29.       (vl-file-delete Export)
  30.       (Vlax-Invoke AdoObj 'SaveToFile Export 1)
  31.       (Vlax-Invoke-Method AdoObj 'Close)
  32.       (princ (strcat "\n成功创建 " Export " 文件!"))
  33.       (vlax-release-object AdoObj)
  34.     )
  35.   )
  36. )

  37. (defun AYL-E->D  (ELst / n s e)
  38.   (setq  s 0)
  39.   (while (= (car ELst) 0)
  40.     (setq ELst (cdr ELst))
  41.   )
  42.   (if (< 0 (setq n (length ELst)) 5)
  43.     (foreach Item ELst
  44.       (setq n (1- n)
  45.       e (expt 256 n)
  46.       s (+ s (* Item e))
  47.       )
  48.     )
  49.   )
  50.   s
  51. )

  52. (defun AYL-null (TmpLst)
  53.   (princ)
  54. )

  55. (defun AYL-Umvlx (Import / BytLst TmpLst Number Int0 Int1 Int2 Int3 Fname Export)
  56.   (if (setq BytLst (AYL-binary Import))
  57.     (progn
  58.       (setq TmpLst nil Number (length BytLst))
  59.       (princ "\n文件大小:")
  60.       (princ Number)
  61.       ;;提取前8个字节 VRTLIB-1
  62.       (repeat 8
  63.   (setq TmpLst (cons (car BytLst) TmpLst)
  64.         BytLst (cdr BytLst)
  65.   )
  66.       )
  67.       (if (= (vl-list->string (reverse TmpLst)) "VRTLIB-1")
  68.   (setq TmpLst nil)
  69.   (progn (princ "\n无效的vlx文件") (VL-EXIT-WITH-VALUE ""))
  70.       )
  71.       ;;提取4个字节,这四个字节表示的整数指除最后16个字节外的所有字节的总数,包括开头的八个字节
  72.       (repeat 4
  73.   (setq TmpLst (cons (car BytLst) TmpLst)
  74.         BytLst (cdr BytLst)
  75.   )
  76.       )
  77.       (setq Int0 (- (AYL-E->D TmpLst) 12) TmpLst nil)
  78.       (while (> (rem Int0 4) 0) (setq Int0 (1+ Int0)))
  79.       (setq Fname (substr Import 1 (- (strlen Import) 4 (strlen (vl-filename-base Import)))))
  80.       (while (> Int0 6)
  81.   (setq TmpLst nil Export Fname)
  82.   (repeat  4
  83.     (setq  TmpLst (cons (car BytLst) TmpLst)
  84.     BytLst (cdr BytLst)
  85.     )
  86.   )
  87.         (setq Number (AYL-E->D TmpLst))
  88.   (while (> (rem Number 4) 0) (setq Number (1+ Number)))
  89.   (setq Int0   (- Int0 Number)
  90.         Int1   (car BytLst)
  91.         Int2   (cadr BytLst)
  92.         Int3   (caddr BytLst)
  93.         BytLst (cdddr BytLst)
  94.   )
  95.   (if (and (member Int1 '(50 55 70 216 0)) (member Int2 '(0 4 5)))
  96.     (progn
  97.       (setq TmpLst nil Number (- Number 7 Int3))
  98.       (repeat Int3
  99.         (setq TmpLst (cons (car BytLst) TmpLst)
  100.         BytLst (cdr BytLst)
  101.         )
  102.       )
  103.       (setq Export (strcat Export (vl-list->string (reverse TmpLst))))
  104.       (setq TmpLst nil)
  105.       (if (> Number 0)
  106.         (repeat Number
  107.     (setq TmpLst (cons (car BytLst) TmpLst)
  108.           BytLst (cdr BytLst)
  109.     )
  110.         )
  111.       )
  112.       (while (= (car TmpLst) 0) (setq TmpLst (cdr TmpLst)))
  113.       (setq TmpLst (reverse TmpLst))
  114.       (cond
  115.         ((= Int1 216)
  116.          (if (= Int2 4)
  117.      (AYL-null TmpLst)
  118.      (progn (princ "文件信息错误") (VL-EXIT-WITH-VALUE ""))
  119.          )
  120.         )
  121.         ((= Int1 50)
  122.          (if (/= Int2 5) (progn (princ "文件类型错误50") (VL-EXIT-WITH-VALUE "")))
  123.          (setq Export (strcat Export ".fas"))
  124.          (if TmpLst
  125.      (progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))
  126.      (close (open Export "w"))
  127.          )
  128.         )
  129.         ((= Int1 0)
  130.          (if (/= Int2 0) (progn (princ "文件类型错误0") (VL-EXIT-WITH-VALUE "")))
  131.          (princ "\n这个类型的文件要根据实际情况更改后缀名")
  132.          (setq Export (strcat Export ".ayl"))
  133.          (if TmpLst
  134.      (progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))
  135.      (close (open Export "w"))
  136.          )
  137.         )
  138.         ((= Int1 55)
  139.          (if (/= Int2 5) (progn (princ "文件类型错误55") (VL-EXIT-WITH-VALUE "")))
  140.          (setq Export (strcat Export ".txt"))
  141.          (if TmpLst
  142.      (progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))
  143.      (close (open Export "w"))
  144.          )
  145.         )
  146.         ((= Int1 70)
  147.          (if (/= Int2 5) (progn (princ "文件类型错误70") (VL-EXIT-WITH-VALUE "")))
  148.          (setq Export (strcat Export ".dcl"))
  149.          (if TmpLst
  150.      (progn (AYL-write-binary Export TmpLst) (princ "  ") (princ Number))
  151.      (close (open Export "w"))
  152.          )
  153.         )
  154.         (t (princ "文件类型错误") (VL-EXIT-WITH-VALUE ""))
  155.       )
  156.     )
  157.     (progn (princ "文件类型错误") (VL-EXIT-WITH-VALUE ""))
  158.   ) ;_ end if
  159.       ) ;_ end while
  160.       (princ "\n")
  161.     ) ;_ end progn
  162.   ) ;_ end if
  163. )

  164. (defun c:Umvlx (/ file)
  165.   (if (setq file (getfiled "" "" "vlx" 0))
  166.     (AYL-Umvlx file)
  167.   )
  168.   (princ)
  169. )

  170. (princ "\n命令名: Umvlx")
  171. (princ "  作者:晨语  QQ:1024045011")
  172. (princ)

点评

真的成功了!谢谢晨语哥哥!  发表于 2014-11-11 22:55

评分

参与人数 3明经币 +3 金钱 +25 收起 理由
flytoday + 1 + 10 赞一个!
自贡黄明儒 + 1 + 15 淡定
lucas_3333 + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2020-3-28 20:52 | 显示全部楼层
KO你 发表于 2020-3-27 21:02
楼主,有没有把多个lisp文件合并成一个vlx的程序

多个vlx要怎么合并呢
发表于 2021-12-2 12:29 | 显示全部楼层
发表于 2021-12-2 12:28 | 显示全部楼层

试试能用了再点赞比较好
发表于 2014-8-24 19:53 | 显示全部楼层
顶起。。。。。。。。。。
发表于 2014-8-24 19:55 | 显示全部楼层
楼主分享的精神可嘉,只是可能会激怒一些人吧!
总之我还是挺你的!
这个应改是分解vlx成FAS吧,只是拿了几个VLX试了下,没有一个成功的。
73208; 错误: 列表中有字符代码错误: 18006
180880; 错误: 列表中有字符代码错误: 18006

点评

只是vlx2fas而已,又不是vlx2lsp,会激怒谁?激怒programmer,还是激怒cracker?  发表于 2014-8-25 15:04
 楼主| 发表于 2014-8-24 20:05 | 显示全部楼层
lucas_3333 发表于 2014-8-24 19:55
楼主分享的精神可嘉,只是可能会激怒一些人吧!
总之我还是挺你的!
这个应改是分解vlx成FAS吧,只是拿了 ...

我一直以来用的都是2004,高版本好象是不行。
发表于 2014-8-24 20:53 | 显示全部楼层
本帖最后由 恕放之生命 于 2014-9-5 09:01 编辑

太强大了,居然测试成功了。带对话框的也可以还原成dcl.
发表于 2014-8-24 20:55 | 显示全部楼层
比用winhex方便多了。
发表于 2014-8-24 21:12 | 显示全部楼层
支持  顶起   有些能成功 有些失败  还是很给力的
发表于 2014-8-24 21:13 | 显示全部楼层

太强大了,居然测试成功了。
发表于 2014-8-24 21:57 | 显示全部楼层
牛人真是太多了,膜拜ing!
发表于 2014-8-24 23:19 | 显示全部楼层
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 00:24 , Processed in 0.311348 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表