将DWG文件作为块插入当前图形的VB代码

tcsl9621

请问哪位老大知道？还烦请相告。

tcsl9621

明经的.NET开发版块做的不好。没有人气。越来越……

tcsl9621

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

 

源程序，有才鸟老大的也有我自已的东西。希望对大家有用。

houlinbo

不行  ，复制过去不能用  

另外再请教 ，我会VBA，要再学VB.net 二次开发需从头开始吗？

tcsl9621

会VBA会有些帮助，但不是完全相同。

houlinbo

关闭时出现致命错误，为什么？QQ420021327

waley111

我是在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