将DWG文件作为块插入当前图形的VB代码
请问哪位老大知道？还烦请相告。 乐筑天下的.NET开发版块做的不好。没有人气。越来越……Public Function InsertBlock(ByVal sourceFileName As String, ByVal newBlockName As String, ByVal po As Point3d) As ObjectId
'Dim sourceFileName As String = "E:\FreeNEST2\FreeNEST2\bin\Project\My test project\Part\Part1.dwg"
'Dim newBlockName As String = "Part1"
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)
Dim btr As BlockTableRecord = trans.GetObject(bt(btr.ModelSpace), OpenMode.ForWrite)
Try
Dim sourceDatabase As Database = GetDatabaseFromFile(sourceFileName)
'把源数据库模型空间中的实体插入到当前数据库的一个新的块表记录中
Dim bobj As ObjectId = HostApplicationServices.WorkingDatabase.Insert(newBlockName, sourceDatabase, False)
Dim bref As BlockReference = New BlockReference(po, bobj)
Dim blockobj As ObjectId = btr.AppendEntity(bref)
''''
Dim empBtr As BlockTableRecord = trans.GetObject(bt(newBlockName), OpenMode.ForRead)
Dim id As ObjectId
For Each id In empBtr
Dim ent As Entity = trans.GetObject(id, OpenMode.ForRead, False)
If TypeOf ent Is AttributeDefinition Then
Dim attRef As AttributeReference = New AttributeReference
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
attRef.SetPropertiesFrom(attDef)
attRef.Position = New Point3d(bref.Position.X + attDef.Position.X, bref.Position.Y + attDef.Position.Y, bref.Position.Z + attDef.Position.Z)
attRef.Height = attDef.Height
attRef.Rotation = attDef.Rotation
attRef.Tag = attDef.Tag
attRef.TextString = attDef.TextString
bref.AttributeCollection.AppendAttribute(attRef)
trans.AddNewlyCreatedDBObject(attRef, True)
End If
Next
'''
trans.AddNewlyCreatedDBObject(bref, True)
Return blockobj
Catch e As System.Exception
Application.ShowAlertDialog(e.Message)
End Try
'''
End Function
Private Function GetDatabaseFromFile(ByVal fileName As String) As Database
'''
Dim databaseFromFile As Database = New Database(False, True)
databaseFromFile.ReadDwgFile(fileName, System.IO.FileShare.Read, False, DBNull.Value.ToString)
'为了让插入块的函数在多个图形文件打开的情况下起作用，你必须使用下面的函数把源数据库对象关闭。
databaseFromFile.CloseInput(True)
Return databaseFromFile
End Function
源程序，有才鸟老大的也有我自已的东西。希望对大家有用。
不行，复制过去不能用
另外再请教 ，我会VBA，要再学VB.net 二次开发需从头开始吗？
会VBA会有些帮助，但不是完全相同。 关闭时出现致命错误，为什么？QQ420021327
我是在VB中用的
先将需要插入的dwg当作外部参照插入，然后再绑定为块
可能这不是最好的办法，但是当时没办法，想了好久才解决的一个办法。
''''''''插入图
Dim insertedBlock As Object'AcadExternalReference
Pt_Temp_1(0) = 0
Pt_Temp_1(1) = 0
Pt_Temp_1(2) = 0
TXT_STR = App.Path & "\twz.dwg"
Set insertedBlock = AcadDoc.ModelSpace.AttachExternalReference(TXT_STR, "TWZ", Pt_Temp_1, 1, 1, 1, 0, False)
AcadDoc.Blocks.Item(insertedBlock.Name).Bind False
页:
[1]