vb.net将外部带属性的块参照插入当前文件

Private Sub b1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles b1.Click
        Dim blockpath As String = IO.Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly.Location) & "" & TextBox2.Text & ".dwg"
        MsgBox(blockpath)
        Dim blockname As String = TextBox2.Text
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Using trans As Transaction = db.TransactionManager.StartTransaction
            Dim ldoc As DocumentLock
            ldoc = doc.LockDocument()
            '添加扩展程序名
            Dim acRegAppTbl As RegAppTable
            acRegAppTbl = trans.GetObject(db.RegAppTableId, OpenMode.ForWrite)
            '' Check to see if the app "PointInfo" is
            '' registered and if not add it to the RegApp table
            If acRegAppTbl.Has("PointInfo") = False Then
                Dim acRegAppTblRec As RegAppTableRecord = New RegAppTableRecord()
                acRegAppTblRec.Name = "PointInfo"
                'acRegAppTbl.UpgradeOpen()
                acRegAppTbl.Add(acRegAppTblRec)
                trans.AddNewlyCreatedDBObject(acRegAppTblRec, True)
                ' trans.Commit()
            End If
            '添加结束
            pan.KeepFocus = False
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False)
            Dim str() As String = Nothing
            Dim sr As String
            If lab2.Text = "" Or lab2.Text = "文件名" Then Exit Sub
            Dim fr As New IO.StreamReader(lab2.Text)
            Do Until fr.EndOfStream
                sr = fr.ReadLine
                If Not sr Is Nothing Then
                    str = sr.Split(",")
                End If
                '读出变量
                Dim pnt As Point3d
                Dim tpnt As Point3d
                Dim tpntalign As Point3d
                Dim name As String = ""
                Dim code As String = ""
                If rb1.Checked = True Then
                    name = str(0)
                    code = ""
                    pnt = New Point3d(Val(str(2)), Val(str(1)), Val(str(3)))
                End If
                If rb2.Checked = True Then
                    name = str(0)
                    code = str(4)
                    pnt = New Point3d(Val(str(2)), Val(str(1)), Val(str(3)))
                End If
                If rb3.Checked = True Then
                    name = str(6)
                    code = str(0)
                    pnt = New Point3d(Val(str(1)), Val(str(2)), Val(str(3)))
                End If
                If rb4.Checked = True Then
                    name = str(0)
                    code = ""
                    pnt = New Point3d(Val(str(1)), Val(str(2)), Val(str(3)))
                End If
                '画圆
                tpnt = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y + Val(TextBox5.Text), 0)
                tpntalign = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y, 0)
                If rb5.Checked = True Then
                    Dim cir As New Circle(pnt, Vector3d.ZAxis, Val(TextBox1.Text))
                    Dim distext As New DBText
                    distext.HorizontalMode = TextHorizontalMode.TextLeft
                    distext.VerticalMode = TextVerticalMode.TextVerticalMid
                    distext.AlignmentPoint = tpntalign
                    If rb7.Checked = True Then
                        distext.TextString = name
                    End If
                    If rb8.Checked = True Then
                        distext.TextString = Format(pnt.Z.ToString, TextBox7.Text)
                    End If
                   
                    distext.Height = Double.Parse(TextBox6.Text)
                    distext.Position = tpnt
                    btr.AppendEntity(distext)
                    trans.AddNewlyCreatedDBObject(distext, True)
                    Dim df As New ResultBuffer
                    df.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, "PointInfo"))
                    df.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, name))
                    df.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, code))
                    cir.XData = df
                    df.Dispose()
                    btr.AppendEntity(cir)
                    trans.AddNewlyCreatedDBObject(cir, True)
                    'trans.Commit()
                    cir.Dispose()
                End If
                '画块
                If rb6.Checked = True Then
                    ' Dim btnew As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)
                    If bt.Has(blockname) = False Then
                        Dim ndb As New Database(False, False)
                        ndb.ReadDwgFile(blockpath, IO.FileShare.Read, False, "")
                        'bt.UpgradeOpen()
                        db.Insert(blockname, ndb, False)
                        ' bt.Add(bb)
                    End If
                    Dim bb As New BlockReference(pnt, bt(blockname))
                    bb.ScaleFactors = New Scale3d(Val(TextBox3.Text), Val(TextBox3.Text), 1)
                    'Dim bref As New AttributeReference(pnt, pnt.Z.ToString, "height", bt(blockname))
                    Dim dfb As New ResultBuffer
                    dfb.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, "PointInfo"))
                    dfb.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, name))
                    dfb.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, code))
                    bb.XData = dfb
                    dfb.Dispose()
                    btr.AppendEntity(bb)
                    trans.AddNewlyCreatedDBObject(bb, True)
                    Dim bdef As BlockTableRecord = trans.GetObject(bt(blockname), OpenMode.ForRead)‘怎么样才能不改动（bt(name))的属性
                    Dim id As ObjectId
                    Dim isatt As Boolean = False
                    For Each id In bdef
                        Dim dbref As DBObject = trans.GetObject(id, OpenMode.ForRead)
                        If TypeOf (dbref) Is AttributeDefinition Then
                            Dim bref As AttributeDefinition = dbref
                            If bref.IsWriteEnabled = False Then
                                bref.UpgradeOpen()
                            End If
                            Dim att As New AttributeReference()
                            'att.SetAttributeFromBlock(bref, bb.BlockTransform)
                            If bref.Tag = "HEIGHT" Then
                                bref.Height = Val(TextBox6.Text)
                                bref.AlignmentPoint = New Point3d(Val(TextBox4.Text), 0, 0)
                                bref.TextString = Format(pnt.Z, TextBox7.Text)
                                isatt = True
                            End If
                            att.SetAttributeFromBlock(bref, bb.BlockTransform)
                            bb.AttributeCollection.AppendAttribute(att)
                            'bref.TextString = ""
                            ' trans.AddNewlyCreatedDBObject(att, True)
                            att.Dispose()
                            doc.Editor.UpdateScreen()
                        End If
                    Next
                    '如果不是属性块，写文字
                    If isatt = False Then
                        tpnt = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y + Val(TextBox5.Text), 0)
                        tpntalign = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y, 0)
                        Dim distext1 As New DBText
                        distext1.HorizontalMode = TextHorizontalMode.TextLeft
                        distext1.VerticalMode = TextVerticalMode.TextVerticalMid
                        distext1.AlignmentPoint = tpntalign
                        If rb7.Checked = True Then
                            distext1.TextString = name
                        End If
                        If rb8.Checked = True Then
                            distext1.TextString = Format(pnt.Z.ToString, TextBox7.Text)
                        End If
                        distext1.Height = Double.Parse(TextBox6.Text)
                        distext1.Position = tpnt
                        btr.AppendEntity(distext1)
                        trans.AddNewlyCreatedDBObject(distext1, True)
                    End If
                End If
                'ldoc.Dispose()
            Loop
            'doc.SendStringToExecute("zoom e ", True, False, False)
            trans.Commit()
            fr.Close()
            pan.KeepFocus = True
        End Using
    End Sub