请教各位大侠：这段程序为什磨总出现“类型不匹配”的错误？

liyanchao1

请各位大侠帮忙看一下这段程序：为什磨运行时总是出现“错误13：类型不匹配！”的错误？ '---------------------------------------------- Sub Test()
On Error Resume Next
Dim a As Variant
Dim c(2) As Double
Dim d As Double c(0) = 100
c(1) = 100
c(2) = 0
Do While 1
' 将鼠标的当前坐标值赋值给a
a = GetPoint
d = ((c(1) - a(1)) ^ 2 + (c(0) - a(0)) ^ 2) ^ 0.5
ThisDrawing.Utility.Prompt d & vbCrLf

Select Case a(2)
Case -1
Exit Sub
Case 0
Case 1
End Select
Loop

End Sub
Function GetPoint()
'功能：返回当前鼠标状态
'返回值：一维数组
'返回0，0，－1表示按下鼠标左键，返回0，0，1表示按下鼠标右键，返回a，b，0表示当前鼠标坐标
On Error GoTo ErrClear
Dim obj As VLAX
Dim pRetVal(2) As Double, retVal
Set obj = New VLAX
obj.EvalLispExpression ("(setq a (grread t) b (car a) c (cadr a))")
Select Case obj.GetLispSymbol("b")
Case 3
pRetVal(2) = -1
Case 5
retVal = obj.GetLispList("c")
pRetVal(0) = retVal(0)
pRetVal(1) = retVal(1)
Case Else
pRetVal(2) = 1
End Select
GetPoint = pRetVal
ErrClear:
Set obj = Nothing
End Function
'-----------------------------------------------------------

mccad

有没有使用VLAX类？

liyanchao1

我已经将您编写的VLAX.CLS导入到该程序的类模块中. '---------------------------------------------- ' 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()
'根据AutoCAD的版本判断使用的库类型
If Left(ThisDrawing.Application.Version, 2) = "15" Then
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
ElseIf Left(ThisDrawing.Application.Version, 2) = "16" Then
Set VL = ThisDrawing.Application.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(lispStatement As String)
'根据LISP表达式调用函数
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(symbolName As String, 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(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(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 '------------------------------------------------------

雪山飞狐_lzh

最好整个Do While循环用Lisp实现，再用VBA利用VLAX类调用，否则过不了一会就会崩溃掉

liyanchao1

飞狐老兄：请给出详细的程序代码，好吗？

雪山飞狐_lzh

http://www.vba.cn/bbs/dispbbs.asp?boardid=4&star=1&replyid=21264&id=20448&skin=0&page=1

liyanchao1

大侠：我想知道为什磨在程序执行到： d = ((c(1) - a(1)) ^ 2 + (c(0) - a(0)) ^ 2) ^ 0.5
时总是出现“运行错误13：类型不匹配”？

雪山飞狐_lzh

频繁调用GetPoint函数会引发错误，而GetPoint函数内错误处理的结果是a为Null