一起来学VB.net(6,实现BOUNDARY命令）

huaxiamengqing · 发表于 2014-3-13 16:57:00

读贴之前可以先看下CAD官方的代码，net实现
命令行实现
net自带的api功能太简单，只让输入一个点参数
但是我们知道CAD的boundary命令很强大，它可以输入一个选择集，只对这个选择集进行boundary.在同事（lsp高手LLXXZZ）的帮助下，我用net封装了这个功能,当然是通过同步发送命令行实现的。
这里只写了对一个物件进行boundary，你也可以修改成对一个选择集进行boundary.
         '获取bo重新生成后的多段线(☆☆☆☆命令的执行模式必须为应用程序环境中执行
Public Class GetBoo
            Dim m_crv As Curve = Nothing, m_rebuildcrv As Curve = Nothing, m_delete As Boolean
            Shared commandName As String = ""
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Private Shared Function IsCommandActive() As Boolean
                  Dim str As [String] = DirectCast(Application.GetSystemVariable("CMDNAMES"), [String])
                  If [String].Compare(commandName, str, True)  0 Then
                     Return True
                  End If
                  Return False
            End Function
            Public Sub New(crv As Curve, delete As Boolean)
                  Try
                     m_crv = crv
                     m_delete = delete
                     Dim Mhandle As String = "", rightcrv As Curve = Nothing, offsetdistance As Double = 0.1
                     Using tr As Transaction = db.TransactionManager.StartTransaction
                        Mhandle = m_crv.AcadObject.Handle
                        ' Dim crvdis As Double = m_crv.GeometricExtents.MaxPoint.DistanceTo(m_crv.GeometricExtents.MinPoint)
                        Dim dbobjts1 As DBObjectCollection = m_crv.GetOffsetCurves(offsetdistance)
                        Dim dbobjts2 As DBObjectCollection = m_crv.GetOffsetCurves(-offsetdistance)
                        If dbobjts1.Count  len2 Then
                              rightcrv = CType(dbobjts2.Item(0), Curve)
                        Else
                              rightcrv = CType(dbobjts1.Item(0), Curve)
                        End If
                     End Using
                     Dim innerpt As Point3d = rightcrv.StartPoint
                     Dim ptarray As Double() = {innerpt.X, innerpt.Y, innerpt.Z}
                     'SegZoom.Zoom(New Point3d, New Point3d, innerpt, 2 * offsetdistance)
                     Application.AcadApplication.ZoomCenter(ptarray, 2 * offsetdistance)
                     'MsgBox("dd")
                     Dim ptstr As String = String.Format(" {0},{1} ", innerpt.X, innerpt.Y)
                     Dim cmdecho As Integer = Application.GetSystemVariable("CMDECHO")
                     Application.SetSystemVariable("CMDECHO", 0)
                     commandName = DirectCast(Application.GetSystemVariable("CMDNAMES"), [String])
                     Dim GetBoundry As String = "._-boundary A B N !(handent """ + Mhandle + """" + ")" + vbCr + vbCr + ptstr + vbCr
                     ' InputBox("", "", GetBoundry)
                     ' Dim GetBoundry As String = "(vl-cmdf " + """" + "._-boundary" + """" + " " + """" + "A" + """" + " " + """" + "B" + """" + " " + """" + "N" + """" + " " + "(handent """ + Mhandle + """" + ")" + """" + """" + " " + """" + """" + ptstr + """" + """" + ")" + vbCr
                     ' Dim comboundry As String = ._-boundary A B N !(handent "58D")"" ""'(1.51325142283495 0.422664600584449 0)""
                     AddHandler db.ObjectAppended, AddressOf db_ObjectAppended
                     ' doc.SendStringToExecute(GetBoundry, True, True, False)
                     ' Application.AcadApplication.ActiveDocument.SendCommand(GetBoundry)
                     'WPF.UI.Pause(2)
                     Dim dataArry As Object() = New Object(0) {}
                     dataArry(0) = GetBoundry
                     doc.AcadDocument.[GetType]().InvokeMember("SendCommand", Reflection.BindingFlags.InvokeMethod, Nothing, doc.AcadDocument, dataArry)
                     'If IsCommandActive() = True Then
                     ' dataArry(0) = "Yes "
                     ' doc.AcadDocument.[GetType]().InvokeMember("SendCommand", Reflection.BindingFlags.InvokeMethod, Nothing, doc.AcadDocument, dataArry)
                     'End If
                     RemoveHandler db.ObjectAppended, AddressOf db_ObjectAppended
                     Application.SetSystemVariable("CMDECHO", cmdecho)
                     Application.AcadApplication.ZoomPrevious()
                     If m_delete Then
                        Using dblock As DocumentLock = doc.LockDocument
                              Using tr As Transaction = db.TransactionManager.StartTransaction
                                 'Dim bt As BlockTable = DirectCast(tr.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                                 ' Dim ms As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                                 Dim mcrv As Curve = RebuildCrv.ObjectId.GetObject(OpenMode.ForWrite)
                                 mcrv.Erase(True)
                                 tr.Commit()
                              End Using
                        End Using
                     End If
                  Catch ex As Exception
                     MsgBox(ex.Message + Environment.NewLine + ex.StackTrace + Environment.NewLine + "请联系作者61692!")
                  End Try
            End Sub
            Public ReadOnly Property RebuildCrv As Curve
                  Get
                     Return m_rebuildcrv
                  End Get
            End Property
            Private Sub db_ObjectAppended(sender As Object, e As ObjectEventArgs)
                  'add the object id
                  m_rebuildcrv = CType(e.DBObject, Curve) '最后一次添加的物件才是重新生成合并的线，前几次是断线
            End Sub
         End Class

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复