- 积分
- 1753
- 明经币
- 个
- 注册时间
- 2011-11-25
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
读贴之前可以先看下CAD官方的代码,net实现
http://adndevblog.typepad.com/au ... y-through-api-.html
命令行实现
http://adndevblog.typepad.com/au ... line-using-net.html
net自带的api功能太简单,只让输入一个点参数
但是我们知道CAD的boundary命令很强大,它可以输入一个选择集,只对这个选择集进行boundary.在同事(lsp高手LLXXZZ)的帮助下,我用net封装了这个功能,当然是通过同步发送命令行实现的。
这里只写了对一个物件进行boundary,你也可以修改成对一个选择集进行boundary.
'获取bo重新生成后的多段线(☆☆☆☆命令的执行模式必须为<CommandMethod("stl", CommandFlags.Session)>应用程序环境中执行
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 < 1 Or dbobjts2.Count < 1 Then
MsgBox("曲线偏移失败!", MsgBoxStyle.Critical, "程序错误请联系作者RTX61692!")
Return
End If
Dim len1 As Double = 0, len2 As Double = 0
For Each dbobj In dbobjts1
Dim ocrv As Curve = CType(dbobj, Curve)
len1 += CAD.Geometry.SegCurve.GetCurveLength(ocrv)
Next
For Each dbobj In dbobjts2
Dim ocrv As Curve = CType(dbobj, Curve)
len2 += CAD.Geometry.SegCurve.GetCurveLength(ocrv)
Next
If len1 > 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 |
|