等不及金斑竹了,我先发个简单的例子
本帖最后由 作者 于 2004-6-28 15:26:10 编辑 <br /><br /> Imports Autodesk.AutoCAD.ApplicationServices<BR>Imports Autodesk.AutoCAD.DatabaseServices<BR>Imports Autodesk.AutoCAD.Runtime<BR>Imports Autodesk.AutoCAD.Interop<BR>Imports Autodesk.AutoCAD.Geometry<BR>Imports AutoCadTM = Autodesk.AutoCAD.DatabaseServices.TransactionManager<BR>Module Module1<BR>End Module
Public Class TlsTemp
<CommandMethod("test")> Public Shared Sub MytestCmd()
Dim pUtility As AcadUtility = Application.DocumentManager.MdiActiveDocument.AcadDocument.Utility<BR> Dim pT As New TlsDatabase<BR> Dim p1, p2 As Object
<BR> '在屏幕上选取两个点生成一条直线<BR> p1 = pUtility.GetPoint()<BR> p2 = pUtility.GetPoint(p1)<BR> Dim pLine As New Line(New Point3d(p1(0), p1(1), p1(2)), New Point3d(p2(0), p2(1), p2(2)))<BR> pT.AppendEntity(pLine)
'生成一条直线,并加入到无名块,插入<BR> Dim p As Object = pUtility.GetPoint()<BR> Dim pEs(0) As DBObject<BR> 'pEs(0) = New Line(New Point3d(p1(0), p1(1), p1(2)), New Point3d(p2(0), p2(1), p2(2)))<BR> pEs(0) = pLine.Clone<BR> Dim pBlock As ObjectId = pT.AppendBlock("*U", pEs)<BR> Dim pObj As New BlockReference(New Point3d(p(0), p(1), p(2)), pBlock)<BR> pT.AppendEntity(pObj)
End Sub
<BR>End Class<BR>Public Class TlsDatabase
'程序功能:向当前模型空间加入实体<BR> Public Function AppendEntity(ByVal TlsEntity As DBObject)
Dim pDatabase As Database = Application.DocumentManager.MdiActiveDocument.Database<BR> Dim pTransactionManager As AutoCadTM = pDatabase.TransactionManager<BR> Dim pStartTransaction As Transaction = pTransactionManager.StartTransaction()
Try
Dim pBlockTable As BlockTable = CType(pTransactionManager.GetObject(pDatabase.BlockTableId, OpenMode.ForRead, False), BlockTable)<BR> Dim pBlockTableRecord As BlockTableRecord = CType(pTransactionManager.GetObject(pBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)
pBlockTableRecord.AppendEntity(TlsEntity)<BR> pTransactionManager.AddNewlyCreatedDBObject(TlsEntity, True)
pStartTransaction.Commit()
Finally
pStartTransaction.Dispose()
End Try
End Function
'程序功能:生成一个新块,并加入实体<BR> Public Function AppendBlock(ByVal Name As String, ByVal Entitys As DBObject()) As ObjectId<BR> Dim i As DBObject<BR> Dim pDatabase As Database = Application.DocumentManager.MdiActiveDocument.Database<BR> Dim pTransactionManager As AutoCadTM = pDatabase.TransactionManager<BR> Dim pStartTransaction As Transaction = pTransactionManager.StartTransaction()<BR> Try
Dim pBlockTable As BlockTable = CType(pTransactionManager.GetObject(pDatabase.BlockTableId, OpenMode.ForWrite, False), BlockTable)<BR> Dim pBlockTableRecord As New BlockTableRecord<BR> pBlockTableRecord.Name = Name<BR> pBlockTable.Add(pBlockTableRecord)<BR> Dim pId As ObjectId = pBlockTableRecord.Id<BR> For Each i In Entitys<BR> pBlockTableRecord.AppendEntity(i)<BR> pTransactionManager.AddNewlyCreatedDBObject(i, True)<BR> Next i<BR> pBlockTableRecord.Close()<BR> pStartTransaction.Commit()
Return pId
Finally
pStartTransaction.Dispose()
End Try
End Function
End Class 金版主用的夹叙夹议之春秋笔法,有滋有味。你来个只练不讲,责把开头的一堆“Imports”解释清楚。:) <A name=30943><FONT color=#0000ff><B>河伯</B></FONT></A>老兄,偶还等着金版主的文章呢,就靠偶的三脚猫可不行,:) 这是用VB.net做的吗?怎么这么像ARX啊。。。
好像挺烦的,不如VBA来得简单啊,不知有什么优点???
页:
[1]