fengxue007 发表于 2008-6-14 23:15:00

想连续标注,该怎么实现呢?急

参考别人的写了一段标注面积的程序,现在想连续标注多个封闭区域面积,并且按“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

robbin840311 发表于 2008-6-16 09:43:00

LZ请联系我,QQ45096732
页: [1]
查看完整版本: 想连续标注,该怎么实现呢?急