vba函数转换成vb.net 出现不能正确获取图形个数错误
本帖最后由 allpurpose 于 2011-8-7 17:02 编辑我把一个获取面积的vba函数改成net 函数,不能正确获取面积,在执行
ThisDrawing.SendCommand(Chr(3) & Chr(3) & "-boundary " & spt & " " & " ")
创建多线段后,貌似成功创建了多线段,因为
Dim oName As String = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).ObjectName
返回了AcDbPolyline,但ThisDrawing.ModelSpace.Count还是返回1 (假设原来只有只有一个矩形)
不知道为什么,难道需要在哪里重新刷新下ThisDrawing.ModelSpace.Count吗?
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
'com
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Interop
Public Class Class2
Private ReadOnly Property ThisDrawing() As AcadDocument
Get
Return Application.DocumentManager.MdiActiveDocument.AcadDocument
End Get
End Property
<CommandMethod("cArea")> _
Public Sub cAa()
On Error GoTo ErrorHandler
Dim zarea As Double
'得到当前的对象总数
Dim oCount As Long
oCount = ThisDrawing.ModelSpace.Count
'得到当前边界创建的对象类型(0 为面域，1 为多段线)
Dim oOL As Integer
oOL = ThisDrawing.GetVariable("HPBOUND")
'得到当前层的名字
Dim currentLayer As String
currentLayer = ThisDrawing.ActiveLayer.Name
'得到当前线体的颜色
Dim oColor As String
oColor = ThisDrawing.GetVariable("CECOLOR")
'新建一层并把它设为当前层
Dim areaLayer As AcadLayer
areaLayer = ThisDrawing.Layers.Add("macula_Area_")
areaLayer.color = 11
ThisDrawing.ActiveLayer = areaLayer
'关闭对象捕捉
ThisDrawing.ObjectSnapMode = False
'设置新的线体颜色
ThisDrawing.SetVariable("CECOLOR", "256")
Dim oLayer As String
While True
'得到新的对象总数，用于分析是否建立了面域或多段线
Dim oNum As Integer = ThisDrawing.ModelSpace.Count
Dim pt As Object
Dim spt As String
ThisDrawing.Utility.Prompt("=================================================")
pt = ThisDrawing.Utility.GetPoint(, vbCrLf & "输入对象的内部一点：")
spt = pt(0) & "," & pt(1)
'设置当前边界创建的对象为面域
ThisDrawing.SetVariable("HPBOUND", 0)
'建立一个面域
ThisDrawing.SendCommand(Chr(3) & Chr(3) & "-boundary " & spt & " " & " ")
'获取把对最后一个对象所在的层，用于分析最后一个对象是否是需要的面域或多段线
'得到最后一个对象的名字
Dim oName As String = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).ObjectName
oLayer = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).Layer
'由三方面判断对象是否建立，如果建立则计算其面积
If (oNum < ThisDrawing.ModelSpace.Count) And ((oName = "AcDbRegion") Or (oName = "AcDbPolyline")) And (oLayer = "macula_Area_") Then
ThisDrawing.SendCommand("draworder lastf ")
ThisDrawing.SendCommand("area ")
ThisDrawing.SendCommand("o ")
ThisDrawing.SendCommand("last ")
zarea = Math.Round(zarea + ThisDrawing.GetVariable("AREA"), 4)
End If
End While
ErrorHandler:
MsgBox(ThisDrawing.ModelSpace.Count)
'MsgBox("选定对象的总面积为： " & zarea)
''删除计算面积产生的对象和图层
'Do While oCount < ThisDrawing.ModelSpace.Count
' ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1).Delete()
'Loop
'ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(currentLayer)
'ThisDrawing.Layers.Item("macula_Area_").Delete()
'ThisDrawing.SetVariable("CECOLOR", oColor)
'ThisDrawing.SetVariable("HPBOUND", oOL)
'ThisDrawing.SendCommand(Chr(3) & Chr(3))
End Sub
end class
页:
[1]