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

fullwolf · 发表于 2011-8-18 19:40:33

本帖最后由 fullwolf 于 2011-8-18 19:55 编辑

这是根据坐标文件格式将数据读出并展绘在图上，点位可以是圆和块。
在论坛上找了好久也没有关于vb.net的外部块插入代码，自己试了好多次，试出来了，第一次用netapi，是引用的2011的dll，在2006上不能运行，不知怎么回事，我是个新手。

代码如下：恳请老师们指正，我总感觉代码有问题。最好给提些意见，将非常感谢。
发现了一个问题。我将块插入到图中以后，发现属性的确是按照我设定的textstring和alighpoint显示。但是我用cad自带的插入块后，怎么也改变了。比如：没运行程序时，用插入块会显示一个属性输入的框，提示输入属性【height】值，此时的默许值是空的，并且插入以后，属性字与点位的距离也是默认的。但是运行程序后，再插入块，也提示输入属性，但是默许值是一个数字，好像程序运行的最后一个数据的值，而且属性对齐点也变成我设定的值了。
难道改块的属性连系统里面的块也改了？

不知我说没说明白，请老师帮帮我，谢谢。

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

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

fullwolf · 发表于 2011-8-18 21:01:21

高手都不在啊，是不是用vb.net的人少啊。看到好多代码都是C的。

fullwolf · 发表于 2011-8-19 17:11:07

怎么没人帮我，快沉底了都。请大侠帮我看看代码哪里把块定义给改了呢。

无志者常立志 · 发表于 2012-4-14 10:25:55

我想找.net 插入块的代码,与楼主一起求索

河伯 · 发表于 2012-4-14 23:09:50

kean博客是个百宝箱，大多数问题都能找到答案：
http://through-the-interface.typepad.com/

然后用这个网站把C#代码转成VB.NET：
http://www.developerfusion.com/tools/convert/csharp-to-vb/

110436819 · 发表于 2012-4-17 15:20:32

o, 好难.........

huaxiamengqing · 发表于 2012-4-25 19:18:16

2011年的帖子，

没人回答。.net是从底层直接引用CAD的类的，你创建了块表的实例，就已经给块表类赋值即初始值就改变了Dim bref As New AttributeReference(pnt, pnt.Z.ToString, "height", bt(blockname)) 插入完后加入 bref = nothing 试试，虽然说 End Using 自动释放资源。

账号		自动登录	找回密码
密码			注册

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