明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1681|回复: 0

vba函数转换成vb.net 出现不能正确获取图形个数错误

[复制链接]
发表于 2011-8-7 17:00:57 | 显示全部楼层 |阅读模式
本帖最后由 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 last  f ")
                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
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 21:41 , Processed in 0.156074 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表