可以实现,如下所示(转载于XDCAD),就是现在还不能同时进行动态捕捉到交点或终点等。
Function GetPoint()
'功能:返回当前鼠标状态
'Vlax类请小心使用,该函数可能使AutoCad崩溃
'返回值:一维数组
'返回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