Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Namespace CADTest
Public Class Class1
<CommandMethod("c2p")> _
Public Sub CircleToPloyline()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim psr As PromptSelectionResult = ed.GetSelection()
'获取选择集,这里就不过滤了
Dim ss As SelectionSet = Nothing
If psr.Status = PromptStatus.OK Then
ss = psr.Value
For Each so As SelectedObject In ss
Dim c As Circle = TryCast(trans.GetObject(so.ObjectId, OpenMode.ForWrite), Circle)
Dim r As Double = c.Radius
Dim cc As Point3d = c.Center
Dim p1 As New Point2d(cc.X + r, cc.Y)
Dim p2 As New Point2d(cc.X - r, cc.Y)
Dim poly As New Polyline()
poly.AddVertexAt(0, p1, 1, 0, 0)
poly.AddVertexAt(1, p2, 1, 0, 0)
poly.AddVertexAt(2, p1, 1, 0, 0)
btr.AppendEntity(poly)
trans.AddNewlyCreatedDBObject(poly, True)
c.[Erase](True)
Next
End If
trans.Commit()
trans.Dispose()
End Sub
<CommandMethod("GET")> _
Public Sub GetEntityType()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim peo As New PromptEntityOptions("请选择一个实体")
Dim per As PromptEntityResult = Nothing
Try
per = ed.GetEntity(peo)
If per.Status = PromptStatus.OK Then
Dim id As ObjectId = per.ObjectId
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Dim ent As Entity = DirectCast(trans.GetObject(id, OpenMode.ForRead, True), Entity)
ed.WriteMessage("实体ObjectId为:" & ent.ObjectId.ToString & "实体类型为:" & ent.[GetType]().FullName)
trans.Commit()
trans.Dispose()
End If
Catch exc As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("发生异常,原因为:" + exc.Message)
End Try
End Sub
End Class
End Namespace
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Namespace CADTest
Public Class Class1
<CommandMethod("c2p")> _
Public Sub CircleToPloyline()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim psr As PromptSelectionResult = ed.GetSelection()
'获取选择集,这里就不过滤了
Dim ss As SelectionSet = Nothing
If psr.Status = PromptStatus.OK Then
ss = psr.Value
For Each so As SelectedObject In ss
Dim c As Circle = TryCast(trans.GetObject(so.ObjectId, OpenMode.ForWrite), Circle)
Dim r As Double = c.Radius
Dim cc As Point3d = c.Center
Dim p1 As New Point2d(cc.X + r, cc.Y)
Dim p2 As New Point2d(cc.X - r, cc.Y)
Dim poly As New Polyline()
poly.AddVertexAt(0, p1, 1, 0, 0)
poly.AddVertexAt(1, p2, 1, 0, 0)
poly.AddVertexAt(2, p1, 1, 0, 0)
btr.AppendEntity(poly)
trans.AddNewlyCreatedDBObject(poly, True)
c.[Erase](True)
Next
End If
trans.Commit()
trans.Dispose()
End Sub
<CommandMethod("GET")> _
Public Sub GetEntityType()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim peo As New PromptEntityOptions("请选择一个实体")
Dim per As PromptEntityResult = Nothing
Try
per = ed.GetEntity(peo)
If per.Status = PromptStatus.OK Then
Dim id As ObjectId = per.ObjectId
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Dim ent As Entity = DirectCast(trans.GetObject(id, OpenMode.ForRead, True), Entity)
ed.WriteMessage("实体ObjectId为:" & ent.ObjectId.ToString & "实体类型为:" & ent.[GetType]().FullName)
trans.Commit()
trans.Dispose()
End If
Catch exc As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("发生异常,原因为:" + exc.Message)
End Try
End Sub
End Class
End Namespace
C#代码和VB.Net代码
【.NET中将圆转成多义线.pdf】点击下载此文件
【VB.NET中将圆转成多义线.rar】点击下载此文件
[本日志由 tiancao1001 于 2011-12-26 09:33 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |