关于CAD VBA二次开发 循环 与判定函数
发布网友
发布时间：2022-10-08 21:08
共1个回答
热心网友
时间：2023-11-18 03:45
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'判断 enter按下
do while
'获取面积，累加
If GetAsyncKeyState(13) = -32767 Then
'enter按下，显示面积
UserForm1.Show
exit do '退出循环
End If
loop
'具体程序如下，已调试通过
'添加模块1
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'窗体代码
Private Sub CommandButton1_Click()
'当前图样的实体数目
Dim n As Long
n = ThisDrawing.ModelSpace.Count
Dim pt As Variant
Dim objpoly As AcadLWPolyline
'将控制权交给CAD
UserForm1.Hide
Do While True
'获取点的位置
pt = ThisDrawing.Utility.GetPoint(, "指定内部点：")
On Error Resume Next
If GetAsyncKeyState(13) = -32767 Then
'enter按下，显示面积
UserForm1.Show
Exit Do '退出循环
End If
On Err GoTo lab
ThisDrawing.SendCommand "-Boundary" & vbCr & pt(0) & "," & pt(1) & vbCr & vbCr
'如果存在边界，则会生成新的实体
If ThisDrawing.ModelSpace.Count > n Then
Set objpoly = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
'为文本框添加面积值
TextBox1.Text = objpoly.Area + Val(TextBox1.Text)
Else
MsgBox "未发现有效的边界。"
End If
Loop
Exit Sub
lab:
MsgBox Err.Description
End Sub
