想连续标注,该怎么实现呢?急
参考别人的写了一段标注面积的程序,现在想连续标注多个封闭区域面积,并且按“Esc”键时退出,该怎么实现呢?本人新手,恳求大侠不吝赐教!谢谢Sub get_area()
On Error Resume Next
Dim n As Long
n = ThisDrawing.ModelSpace.Count
Dim pt As Variant
Dim txet_ht As Double, gch As Double
pt = ThisDrawing.Utility.GetPoint(, "请指定区域内部点: ")
ThisDrawing.SendCommand "_-Boundary" & vbCr & pt(0) & "," & pt(1) & vbCr & vbCr
Dim lwpLineObj As AcadLWPolyline
Dim textObj As AcadMText
Dim area As Double
If ThisDrawing.ModelSpace.Count > n Then
Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
lwpLineObj.color = acRed
txet_ht = 15
txet_ht = ThisDrawing.Utility.GetReal("请输入文字高度<15.0>: ")
gch = ThisDrawing.Utility.GetReal("请输入区域高程<" & gch & ">:")
area = Round(lwpLineObj.area, 2)
Set textObj = ThisDrawing.ModelSpace.AddMText(pt, 30 * txet_ht, "高程:" & gch & "\P" & "面积:" & area)
textObj.Height = txet_ht
textObj.Update
If Err Then
Err.Clear
Exit Sub
End If
Else
MsgBox "未发现封闭区域,请检查选定区域是否闭合. "
End If
End Sub
LZ请联系我,QQ45096732
页:
[1]