斑竹看看这个链接为何不能用了？VLAX类

ilovehuizi

斑竹大人 ，不得不在麻烦你一下。我现在需要 vlax类 ,本站有如下链接 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=9328 但是现在不能下载，斑竹可否重新激活链接，让小弟下载一次。 小弟 先谢了～～

雪山飞狐_lzh

看看10楼的发言

ilovehuizi

斑竹关键是我现在大不开代码，怎么拷贝呢？ 十楼的发言 偶已经看了。


麻烦 多指点～···

雪山飞狐_lzh

初级用户是不能看见，：） ' VLAX.CLS v2.0 (Last updated 8/1/2003)
' Copyright 1999-2001 by Frank Oquendo
'
' 该程序由明经通道修改支持2004版本
' http://www.mjtd.com
'
' Permission to use, copy, modify, and distribute this software
' for any purpose and without fee is hereby granted, provided
' that the above copyright notice appears in all copies and
' that both that copyright notice and the limited warranty and
' restricted rights notice below appear in all supporting
' documentation.
'
' FRANK OQUENDO (THE AUTHOR) PROVIDES THIS PROGRAM "AS IS" AND WITH
' ALL FAULTS. THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY
' OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. THE AUTHOR
' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
' Use, duplication, or disclosure by the U.S. Government is subject to
' restrictions set forth in FAR 52.227-19 (Commercial Computer
' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
' (Rights in Technical Data and Computer Software), as applicable.
'
' VLAX.cls allows developers to evaluate AutoLISP expressions from
' Visual Basic or VBA
'
' Notes:
' All code for this class module is publicly available througout various posts
' at news://discussion.autodesk.com/autodesk.autocad.customization.vba. I do not
' claim copyright or authorship on code presented in these posts, only on this
' compilation of that code. In addition, a great big "Thank you!" to Cyrille Fauvel
' demonstrating the use of the VisualLISP ActiveX Module.
'
' Dependencies:
' Use of this class module requires the following application:
' 1. VisualLISP Private VL As Object
Private VLF As Object Private Sub Class_Initialize() If Left(ThisDrawing.Application.Version, 2) = "15" Then
Set VL = GetInterfaceObject("VL.Application.1")
ElseIf Left(ThisDrawing.Application.Version, 2) = "16" Then
Set VL = GetInterfaceObject("VL.Application.16")
End If
Set VLF = VL.ActiveDocument.Functions
End Sub Private Sub Class_Terminate() Set VLF = Nothing
Set VL = Nothing End Sub Public Function EvalLispExpression(ByVal lispStatement As String) Dim sym As Object, ret As Object, retval

Set sym = VLF.Item("read").funcall(lispStatement)
On Error Resume Next
retval = VLF.Item("eval").funcall(sym)
If Err Then
EvalLispExpression = ""
Else
EvalLispExpression = retval
End If End Function Public Sub SetLispSymbol(ByVal symbolName As String, ByVal Value) Dim sym As Object, ret, symvalue

symvalue = Value
Set sym = VLF.Item("read").funcall(symbolName)
ret = VLF.Item("set").funcall(sym, symvalue)
EvalLispExpression "(defun translate-variant (data) (cond ((= (type data) 'list) (mapcar 'translate-variant data)) ((= (type data) 'variant) (translate-variant (vlax-variant-value data))) ((= (type data) 'safearray) (mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"
EvalLispExpression "(setq " & symbolName & "(translate-variant " & symbolName & "))"
EvalLispExpression "(setq translate-variant nil)" End Sub Public Function GetLispSymbol(ByVal symbolName As String) Dim sym As Object, ret, symvalue

symvalue = Value
Set sym = VLF.Item("read").funcall(symbolName)
GetLispSymbol = VLF.Item("eval").funcall(sym) End Function Public Function GetLispList(ByVal symbolName As String) As Variant Dim sym As Object, list As Object
Dim Count, elements(), i As Long

Set sym = VLF.Item("read").funcall(symbolName)
Set list = VLF.Item("eval").funcall(sym)

Count = VLF.Item("length").funcall(list)

ReDim elements(0 To Count - 1) As Variant

For i = 0 To Count - 1
elements(i) = VLF.Item("nth").funcall(i, list)
Next

GetLispList = elements

End Function Public Sub NullifySymbol(ParamArray symbolName()) Dim i As Integer

For i = LBound(symbolName) To UBound(symbolName)
EvalLispExpression "(setq " & CStr(symbolName(i)) & " nil)"
Next End Sub

ilovehuizi

多谢斑竹～～ 斑竹节日快乐！

NetBee

好东东，最近准备用VBA了