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

fullwolf

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

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

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




  

1. Private Sub b1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles b1.Click
   
2.         Dim blockpath As String = IO.Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly.Location) & "\" & TextBox2.Text & ".dwg"
   
3.         MsgBox(blockpath)
   
4.         Dim blockname As String = TextBox2.Text
   
5.         Dim doc As Document = Application.DocumentManager.MdiActiveDocument
   
6.         Dim db As Database = doc.Database
   
7.         Using trans As Transaction = db.TransactionManager.StartTransaction
   
8.             Dim ldoc As DocumentLock
   
9.             ldoc = doc.LockDocument()
   
10.             '添加扩展程序名
    
11.             Dim acRegAppTbl As RegAppTable
    
12.             acRegAppTbl = trans.GetObject(db.RegAppTableId, OpenMode.ForWrite)
    
13.             '' Check to see if the app "PointInfo" is
    
14.             '' registered and if not add it to the RegApp table
    
15.             If acRegAppTbl.Has("PointInfo") = False Then
    
16.                 Dim acRegAppTblRec As RegAppTableRecord = New RegAppTableRecord()
    
17.                 acRegAppTblRec.Name = "PointInfo"
    
18.                 'acRegAppTbl.UpgradeOpen()
    
19.                 acRegAppTbl.Add(acRegAppTblRec)
    
20.                 trans.AddNewlyCreatedDBObject(acRegAppTblRec, True)
    
21.                 ' trans.Commit()
    
22.             End If
    
23.             '添加结束
    
24.             pan.KeepFocus = False
    
25.             Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
    
26.             Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False)
    
27.             Dim str() As String = Nothing
    
28.             Dim sr As String
    
29.             If lab2.Text = "" Or lab2.Text = "文件名" Then Exit Sub
    
30.             Dim fr As New IO.StreamReader(lab2.Text)
    
31.             Do Until fr.EndOfStream
    
32.                 sr = fr.ReadLine
    
33.                 If Not sr Is Nothing Then
    
34.                     str = sr.Split(",")
    
35.                 End If
    
36.                 '读出变量
    
37.                 Dim pnt As Point3d
    
38.                 Dim tpnt As Point3d
    
39.                 Dim tpntalign As Point3d
    
40.                 Dim name As String = ""
    
41.                 Dim code As String = ""
    
42.                 If rb1.Checked = True Then
    
43.                     name = str(0)
    
44.                     code = ""
    
45.                     pnt = New Point3d(Val(str(2)), Val(str(1)), Val(str(3)))
    
46.                 End If
    
47.                 If rb2.Checked = True Then
    
48.                     name = str(0)
    
49.                     code = str(4)
    
50.                     pnt = New Point3d(Val(str(2)), Val(str(1)), Val(str(3)))
    
51.                 End If
    
52.                 If rb3.Checked = True Then
    
53.                     name = str(6)
    
54.                     code = str(0)
    
55.                     pnt = New Point3d(Val(str(1)), Val(str(2)), Val(str(3)))
    
56.                 End If
    
57.                 If rb4.Checked = True Then
    
58.                     name = str(0)
    
59.                     code = ""
    
60.                     pnt = New Point3d(Val(str(1)), Val(str(2)), Val(str(3)))
    
61.                 End If
    
62.                 '画圆
    
63.                 tpnt = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y + Val(TextBox5.Text), 0)
    
64.                 tpntalign = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y, 0)
    
65.                 If rb5.Checked = True Then
    
66.                     Dim cir As New Circle(pnt, Vector3d.ZAxis, Val(TextBox1.Text))
    
67.                     Dim distext As New DBText
    
68.                     distext.HorizontalMode = TextHorizontalMode.TextLeft
    
69.                     distext.VerticalMode = TextVerticalMode.TextVerticalMid
    
70.                     distext.AlignmentPoint = tpntalign
    
71.                     If rb7.Checked = True Then
    
72.                         distext.TextString = name
    
73.                     End If
    
74.                     If rb8.Checked = True Then
    
75.                         distext.TextString = Format(pnt.Z.ToString, TextBox7.Text)
    
76.                     End If
    
77.                   
    
78.                     distext.Height = Double.Parse(TextBox6.Text)
    
79.                     distext.Position = tpnt
    
80.                     btr.AppendEntity(distext)
    
81.                     trans.AddNewlyCreatedDBObject(distext, True)
    
82.                     Dim df As New ResultBuffer
    
83.                     df.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, "PointInfo"))
    
84.                     df.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, name))
    
85.                     df.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, code))
    
86.                     cir.XData = df
    
87.                     df.Dispose()
    
88.                     btr.AppendEntity(cir)
    
89.                     trans.AddNewlyCreatedDBObject(cir, True)
    
90.                     'trans.Commit()
    
91.                     cir.Dispose()
    
92.                 End If
    
93.                 '画块
    
94.                 If rb6.Checked = True Then
    
95.                     ' Dim btnew As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)
    
96.                     If bt.Has(blockname) = False Then
    
97.                         Dim ndb As New Database(False, False)
    
98.                         ndb.ReadDwgFile(blockpath, IO.FileShare.Read, False, "")
    
99.                         'bt.UpgradeOpen()
    
100.                         db.Insert(blockname, ndb, False)
     
101.                         ' bt.Add(bb)
     
102.                     End If
     
103.                     Dim bb As New BlockReference(pnt, bt(blockname))
     
104.                     bb.ScaleFactors = New Scale3d(Val(TextBox3.Text), Val(TextBox3.Text), 1)
     
105.                     'Dim bref As New AttributeReference(pnt, pnt.Z.ToString, "height", bt(blockname))
     
106.                     Dim dfb As New ResultBuffer
     
107.                     dfb.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, "PointInfo"))
     
108.                     dfb.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, name))
     
109.                     dfb.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, code))
     
110.                     bb.XData = dfb
     
111.                     dfb.Dispose()
     
112.                     btr.AppendEntity(bb)
     
113.                     trans.AddNewlyCreatedDBObject(bb, True)
     
114.                     Dim bdef As BlockTableRecord = trans.GetObject(bt(blockname), OpenMode.ForRead)‘怎么样才能不改动（bt(name))的属性
     
115.                     Dim id As ObjectId
     
116.                     Dim isatt As Boolean = False
     
117.                     For Each id In bdef
     
118.                         Dim dbref As DBObject = trans.GetObject(id, OpenMode.ForRead)
     
119.                         If TypeOf (dbref) Is AttributeDefinition Then
     
120.                             Dim bref As AttributeDefinition = dbref
     
121.                             If bref.IsWriteEnabled = False Then
     
122.                                 bref.UpgradeOpen()
     
123.                             End If
     
124.                             Dim att As New AttributeReference()
     
125.                             'att.SetAttributeFromBlock(bref, bb.BlockTransform)
     
126.                             If bref.Tag = "HEIGHT" Then
     
127.                                 bref.Height = Val(TextBox6.Text)
     
128.                                 bref.AlignmentPoint = New Point3d(Val(TextBox4.Text), 0, 0)
     
129.                                 bref.TextString = Format(pnt.Z, TextBox7.Text)
     
130.                                 isatt = True
     
131.                             End If
     
132.                             att.SetAttributeFromBlock(bref, bb.BlockTransform)
     
133.                             bb.AttributeCollection.AppendAttribute(att)
     
134.                             'bref.TextString = ""
     
135.                             ' trans.AddNewlyCreatedDBObject(att, True)
     
136.                             att.Dispose()
     
137.                             doc.Editor.UpdateScreen()
     
138.                         End If
     
139.                     Next
     
140.                     '如果不是属性块，写文字
     
141.                     If isatt = False Then
     
142.                         tpnt = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y + Val(TextBox5.Text), 0)
     
143.                         tpntalign = New Point3d(pnt.X + Val(TextBox4.Text), pnt.Y, 0)
     
144.                         Dim distext1 As New DBText
     
145.                         distext1.HorizontalMode = TextHorizontalMode.TextLeft
     
146.                         distext1.VerticalMode = TextVerticalMode.TextVerticalMid
     
147.                         distext1.AlignmentPoint = tpntalign
     
148.                         If rb7.Checked = True Then
     
149.                             distext1.TextString = name
     
150.                         End If
     
151.                         If rb8.Checked = True Then
     
152.                             distext1.TextString = Format(pnt.Z.ToString, TextBox7.Text)
     
153.                         End If
     
154.                         distext1.Height = Double.Parse(TextBox6.Text)
     
155.                         distext1.Position = tpnt
     
156.                         btr.AppendEntity(distext1)
     
157.                         trans.AddNewlyCreatedDBObject(distext1, True)
     
158.                     End If
     
159.                 End If
     
160.                 'ldoc.Dispose()
     
161.             Loop
     
162.             'doc.SendStringToExecute("zoom e ", True, False, False)
     
163.             trans.Commit()
     
164.             fr.Close()
     
165.             pan.KeepFocus = True
     
166.         End Using
     
167.     End Sub
     

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

fullwolf

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

fullwolf

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

无志者常立志

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

河伯

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

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

110436819

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

huaxiamengqing

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