雪山飞狐_lzh 发表于 2004-6-28 13:40:00

等不及金斑竹了,我先发个简单的例子

Imports Autodesk..ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Geometry
Imports AutoCadTM = Autodesk.AutoCAD.DatabaseServices.TransactionManager
Module Module1
End Module
Public Class TlsTemp
                          Public Shared Sub MytestCmd()
                                                       Dim pUtility As AcadUtility = Application.DocumentManager.MdiActiveDocument.AcadDocument.Utility
                                                       Dim pT As New TlsDatabase
                                                       Dim p1, p2 As Object
                                                       '在屏幕上选取两个点生成一条直线
                                                       p1 = pUtility.GetPoint()
                                                       p2 = pUtility.GetPoint(p1)
                                                       Dim pLine As New Line(New Point3d(p1(0), p1(1), p1(2)), New Point3d(p2(0), p2(1), p2(2)))
                                                       pT.AppendEntity(pLine)
                                                       '生成一条直线,并加入到无名块,插入
                                                       Dim p As Object = pUtility.GetPoint()
                                                       Dim pEs(0) As DBObject
                                                       'pEs(0) = New Line(New Point3d(p1(0), p1(1), p1(2)), New Point3d(p2(0), p2(1), p2(2)))
                                                       pEs(0) = pLine.Clone
                                                       Dim pBlock As ObjectId = pT.AppendBlock("*U", pEs)
                                                       Dim pObj As New BlockReference(New Point3d(p(0), p(1), p(2)), pBlock)
                                                       pT.AppendEntity(pObj)
                       End Sub
End Class
Public Class TlsDatabase
                       '程序功能:向当前模型空间加入实体
                       Public Function AppendEntity(ByVal TlsEntity As DBObject)
                                                       Dim pDatabase As Database = Application.DocumentManager.MdiActiveDocument.Database
                                                       Dim pTransactionManager As AutoCadTM = pDatabase.TransactionManager
                                                       Dim pStartTransaction As Transaction = pTransactionManager.StartTransaction()
                                                       Try
                                                                                       Dim pBlockTable As BlockTable = CType(pTransactionManager.GetObject(pDatabase.BlockTableId, OpenMode.ForRead, False), BlockTable)
                                                                                       Dim pBlockTableRecord As BlockTableRecord = CType(pTransactionManager.GetObject(pBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)
                                                                                       pBlockTableRecord.AppendEntity(TlsEntity)
                                                                                       pTransactionManager.AddNewlyCreatedDBObject(TlsEntity, True)
                                                                                       pStartTransaction.Commit()
                                                       Finally
                                                                                       pStartTransaction.Dispose()
                                                       End Try
                       End Function
                       '程序功能:生成一个新块,并加入实体
                       Public Function AppendBlock(ByVal Name As String, ByVal Entitys As DBObject()) As ObjectId
                                                       Dim i As DBObject
                                                       Dim pDatabase As Database = Application.DocumentManager.MdiActiveDocument.Database
                                                       Dim pTransactionManager As AutoCadTM = pDatabase.TransactionManager
                                                       Dim pStartTransaction As Transaction = pTransactionManager.StartTransaction()
                                                       Try
                                                                                       Dim pBlockTable As BlockTable = CType(pTransactionManager.GetObject(pDatabase.BlockTableId, OpenMode.ForWrite, False), BlockTable)
                                                                                       Dim pBlockTableRecord As New BlockTableRecord
                                                                                       pBlockTableRecord.Name = Name
                                                                                       pBlockTable.Add(pBlockTableRecord)
                                                                                       Dim pId As ObjectId = pBlockTableRecord.Id
                                                                                       For Each i In Entitys
                                                                                                                       pBlockTableRecord.AppendEntity(i)
                                                                                                                       pTransactionManager.AddNewlyCreatedDBObject(i, True)
                                                                                       Next i
                                                                                       pBlockTableRecord.Close()
                                                                                       pStartTransaction.Commit()
                                                                                       Return pId
                                                       Finally
                                                                                       pStartTransaction.Dispose()
                                                       End Try
                       End Function
End Class

河伯 发表于 2004-6-29 22:08:00

金版主用的夹叙夹议之春秋笔法,有滋有味。你来个只练不讲,责把开头的一堆“Imports”解释清楚。:)

雪山飞狐_lzh 发表于 2004-6-30 08:00:00

河伯老兄,偶还等着金版主的文章呢,就靠偶的三脚猫可不行,:)

cag 发表于 2004-7-10 18:28:00

这是用VB.net做的吗?怎么这么像ARX啊。。。
好像挺烦的,不如VBA来得简单啊,不知有什么优点???
页: [1]
查看完整版本: 等不及金斑竹了,我先发个简单的例子