VB编程,对话框使用acedGetXXX函数和ACAD交互
本帖最后由 作者 于 2009-9-17 22:36:51 编辑VB编程,非模态窗口中，如何中断当前原有的GETXXX命令，并重新运行另一GETXXXX
如下图
使用了功能：
Private Sub Form_Load()
Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object, obj_Util As Object
Set obj_Acad = GetObject(, "autocad.application")
If Err Then
Err.Clear
On Error Resume Next
Set obj_Acad = CreateObject("autocad.application")
If Err Then
Err.Clear
MsgBox "不能运行AutoCAD,请检查是否安装！", vbOKOnly, "警告！"
Exit Function
End If
End If
obj_Acad.Visible = True
Set obj_Doc = obj_Acad.ActiveDocument
Set obj_Util = obj_Doc.Utility
Set obj_ModelSpace = obj_Doc.ModelSpace
End Sub
'获取点按钮
Private Sub Getpoint_Click()
Dim pt As Variant
Do While CAD.Getpoint(pt, vbCrLf & "获取点<退出>:")
If IsNull(pt) Then
'lop1 = False
Else
CAD.Addcircle pt, 100
End If
Loop
End Sub
Public Function Getpoint(ByRef rePnt As Variant, ByRef inputString As String, Optional Msg As String, Optional pt As Variant) As Boolean
'On Error Resume Next
ActiveDoc
rePnt = obj_Util.Getpoint(, Msg)
If Err Then
If Err.Number = -2145320928 Then
'Dim inputString As String
Err.Clear
inputString = ThisDrawing.Utility.GetInput
'GetPoint = True
Else
Getpoint = False
MsgBox "getpoint错误: " & Err.Description
Err.Clear
End If
Else
' Display point coordinates
'MsgBox "The WCS of the point is: " & reVal(0) & ", " & reVal(1) & ", " & reVal(2), , "GetInput Example"
Getpoint = True
End If
End Function
Public Function GetEntity0(ByRef Retobj As Variant, ByRef inputString As String, Optional Msg As String = "") As Boolean
On Error Resume Next
Dim Point As Variant
ActiveDoc
obj_Util.GetEntity Retobj, Point, Msg
If Err Then
If Err.Number = -2145320928 Then
' One of the keywords was entered
Err.Clear
inputString = ThisDrawing.Utility.GetInput
Else
MsgBox "GetEntity0错误: " & Err.Description
Err.Clear
GetEntity0 = False
End If
Else
GetEntity0 = True
End If
End Function
Public Function Addcircle(ByRef Center As Variant, ByVal Radius As Double) As Object
Dim obj_circle As Object '定义圆对象
Dim newstr As String
On Error Resume Next
If Not boo Then
MsgBox "请先生成autocad程序对象", vbOKOnly, "autocad程序对象？"
Exit Function
End If
Set obj_circle = obj_ModelSpace.Addcircle(Center, Radius)
Set Addcircle = obj_circle
End Function
*.Utility.GetPoint(, "Enter a point: ")
*.Utility.GetDistance(, "Enter distance: ")
想达到效果：
1、在非模态状态下，本来是使用getpoint的，但还是getpoint的命令状态下，就按获取距离按钮，这时就取消原命令而运行GetDistance
或
2、在非模态状态下，本来是使用GetDistance的，但还是GetDistance的命令状态下，就按获取点按钮，这时就取消原命令而运行getpoint
本意是想取消原命令，但实际却变成嵌套了，即运行完GetDistance后，还会要求选取一个点。
如何取消当前的命令呢(getXXXXX)
<p>多谢分享,学习过程中.</p>
页:
[1]