将dwg dll写为二进制文本打包到vlx后还原文件的问题

言戲無軍

将dwg dll写为二进制文本打包到vlx后还原文件的问题
将dwg dll写为二进制文本有不死猫老师的函数

2. [code=lisp];[code=lisp]Subject:binary conversion to text by lisp 二进制文件转文本
   
3. ;Writen:nonsmall(不死猫)
   
4. ;Date:2009 10 18
   
5. ;All Rights Reserved 版权所有 nonsmall(不死猫)
   
6. ;Contact: QQ:43797405 Email:nonsmall@163.com
   
7. (defun binaryToText(FileName / ADODB.Stream)
   
8.   (Setq ADODB.Stream (Vlax-Get-Or-Create-Object "ADODB.Stream" ))
   
9.   (Vlax-Put-Property ADODB.Stream 'Type 1 )
   
10.   (Vlax-Invoke ADODB.Stream 'Open )
    
11.   (Vlax-Invoke-Method ADODB.Stream 'LoadFromFile FileName )
    
12.   (Vlax-Put-Property ADODB.Stream 'Position 0 )
    
13.   (Vlax-Invoke-Method ADODB.Stream 'Write (car (list (Vlax-Invoke-Method ADODB.Stream 'Read (Vlax-Get ADODB.Stream 'Size )) (Vlax-Put-Property ADODB.Stream 'Position 0 ))))
    
14.   (Vlax-Put-Property ADODB.Stream 'Position 0 )
    
15.   (Vlax-Put-Property ADODB.Stream 'Type 2 )  
    
16.   (Vlax-Put-Property ADODB.Stream 'CharSet "us-ascii" )
    
17.   (Vlax-Invoke ADODB.Stream 'ReadText)
    
18.   ;(vlax-release-object ADODB.Stream)
    
19. )
    
20. ;Test
    
21. ;(binaryToText "d:\\new.fas")
    
22. ;(binaryToText "d:\\034.dwg")
    
23. ;(binaryToText "d:\\double_line.gif")

[code=lisp];[code=lisp]Subject:binary conversion to text by lisp 二进制文件转文本<br /> ;Writen:nonsmall(不死猫)<br /> ;Date:2009 10 18<br /> ;All Rights Reserved 版权所有 nonsmall(不死猫)<br /> ;Contact: QQ:43797405 Email:nonsmall@163.com<br /> (defun binaryToText(FileName / ADODB.Stream)<br />   (Setq ADODB.Stream (Vlax-Get-Or-Create-Object "ADODB.Stream" ))<br />   (Vlax-Put-Property ADODB.Stream 'Type 1 )<br />   (Vlax-Invoke ADODB.Stream 'Open )<br />   (Vlax-Invoke-Method ADODB.Stream 'LoadFromFile FileName )<br />   (Vlax-Put-Property ADODB.Stream 'Position 0 )<br />   (Vlax-Invoke-Method ADODB.Stream 'Write (car (list (Vlax-Invoke-Method ADODB.Stream 'Read (Vlax-Get ADODB.Stream 'Size )) (Vlax-Put-Property ADODB.Stream 'Position 0 ))))<br />   (Vlax-Put-Property ADODB.Stream 'Position 0 )<br />   (Vlax-Put-Property ADODB.Stream 'Type 2 )  <br />   (Vlax-Put-Property ADODB.Stream 'CharSet "us-ascii" )<br />   (Vlax-Invoke ADODB.Stream 'ReadText)<br />   ;(vlax-release-object ADODB.Stream)<br /> )<br /> ;Test<br /> ;(binaryToText "d:\\new.fas")<br /> ;(binaryToText "d:\\034.dwg")<br /> ;(binaryToText "d:\\double_line.gif")

将二进制文本还原为dwg.dll的函数目前只看到高飞鸟的函数，在08CAD下，32位CAD正常使用，但在2010以上64位CAD都失败，WIN10 系统

2. [code=lisp];;;Write Binary file from  strings 高飞鸟大师
   
3. (defun WriteBinary1 (FileName buffer / wsObj str)
   
4.   (if (setq wsObj (vlax-create-object "ScriptControl"))
   
5.     (progn
   
6.       (vlax-put wsObj "language" "VBS")
   
7.       (setq str
   
8.        "Sub WriteBinary(FileName, Buf)
   
9.         Const adTypeBinary = 1
   
10.         Const adSaveCreateOverWrite = 2
    
11.         Dim stream, xmldom, node
    
12.         Set xmldom = CreateObject("Microsoft.XMLDOM")
    
13.         Set node = xmldom.CreateElement("binary")
    
14.         node.DataType = "bin.hex"
    
15.         node.Text = Buf
    
16.         Set stream = CreateObject("ADODB.Stream")
    
17.         stream.Type = adTypeBinary
    
18.         stream.Open
    
19.         stream.write node.NodeTypedValue
    
20.         stream.saveToFile FileName, adSaveCreateOverWrite
    
21.         stream.Close
    
22.         Set stream = Nothing
    
23.         Set node = Nothing
    
24.         Set xmldom = Nothing
    
25.         End Sub"
    
26.       )
    
27.       (vlax-invoke wsObj 'ExecuteStatement str)
    
28.       (vlax-invoke wsObj 'run "WriteBinary" Filename buffer)
    
29.       (vlax-release-object wsObj)
    
30.       (princ)
    
31.     )
    
32.   )
    
33. )

[code=lisp];;;Write Binary file from  strings 高飞鸟大师<br /> (defun WriteBinary1 (FileName buffer / wsObj str)<br />   (if (setq wsObj (vlax-create-object "ScriptControl"))<br />     (progn<br />       (vlax-put wsObj "language" "VBS")<br />       (setq str<br />        "Sub WriteBinary(FileName, Buf)<br />         Const adTypeBinary = 1<br />         Const adSaveCreateOverWrite = 2<br />         Dim stream, xmldom, node<br />         Set xmldom = CreateObject("Microsoft.XMLDOM")<br />         Set node = xmldom.CreateElement("binary")<br />         node.DataType = "bin.hex"<br />         node.Text = Buf<br />         Set stream = CreateObject("ADODB.Stream")<br />         stream.Type = adTypeBinary<br />         stream.Open<br />         stream.write node.NodeTypedValue<br />         stream.saveToFile FileName, adSaveCreateOverWrite<br />         stream.Close<br />         Set stream = Nothing<br />         Set node = Nothing<br />         Set xmldom = Nothing<br />         End Sub"<br />       )<br />       (vlax-invoke wsObj 'ExecuteStatement str)<br />       (vlax-invoke wsObj 'run "WriteBinary" Filename buffer)<br />       (vlax-release-object wsObj)<br />       (princ)<br />     )<br />   )<br /> )

不知道有没有高手能将第二个还原的函数修改下，感觉vbs在高版本下可能受限制。或者共享下私藏。
拜托了。

高飞鸟大师在2011年就解决这个问题了，只支持32位CAD，如果有dynamwrapperx可以用新的

高飞鸟源码如下：真实能用的，猫老师那个不行。

Kye

言戲無軍 发表于 2019-8-18 06:15
我自己搜索解决了

请问怎么解决的？注册了支持scriptControl的64位DLL？      一一一一一一一一一一一一一一一一一一一一一一一一http://club.excelhome.net/forum. ... ead&tid=1418713  这上面提到的方法应该也可以，没测试。                                                                                                                                                           想知道如果不注册DLL之类，能有什么好办法没

言戲無軍

Kye 发表于 2019-8-18 18:37
高版已经翻译了啊!大侠又重新翻译了？64位CAD下(setq wsObj (vlax-create-object "ScriptControl"))这句运 ...

你没看出来，高版中间有一段VBS吗，那个不是vlisp，是脚本。

言戲無軍

Kye 发表于 2019-8-18 16:33
请问怎么解决的？注册了支持scriptControl的64位DLL？      一一一一一一一一一一一一一一一一一一一一一 ...

把文章里的vbs 翻译成vlisp就ok了

言戲無軍

我自己搜索解决了

Kye

高版已经翻译了啊!大侠又重新翻译了？64位CAD下(setq wsObj (vlax-create-object "ScriptControl"))这句运行结果为nil(如果不注册支持ScriptControl的64位DLL)，您如何避开的?

Kye

我还以为高版混合运用就是翻译，谢谢啊，我是玩vb6搜到了vbs源代码，原作者程序解释才想起高版和黄老师的打包之类的贴子，才一路找过来的

清清绿茶

不懂VBS，可以把翻译后的源码贴上来吗？

清清绿茶

不懂VBS，可以把翻译后的源码贴上来吗？

LIULISHENG

高级技巧，学习了