vb.net将外部带属性的块参照插入当前文件
本帖最后由 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
高手都不在啊，是不是用vb.net的人少啊。看到好多代码都是C的。 怎么没人帮我，快沉底了都。请大侠帮我看看代码哪里把块定义给改了呢。 我想找.net 插入块的代码,与楼主一起求索 kean博客是个百宝箱，大多数问题都能找到答案：
http://through-the-interface.typepad.com/
然后用这个网站把C#代码转成VB.NET：
http://www.developerfusion.com/tools/convert/csharp-to-vb/ o, 好难......... 2011年的帖子，没人回答。.net是从底层直接引用CAD的类的，你创建了块表的实例，就已经给块表类赋值即初始值就改变了Dim bref As New AttributeReference(pnt, pnt.Z.ToString, "height", bt(blockname)) 插入完后 加入 bref = nothing 试试，虽然说 End Using 自动释放资源。
页:
[1]