请大家帮看一下关于块属性的代码问题？[OK]
本帖最后由 wolunli 于 2011-4-13 15:59 编辑请大家帮看一下下面关于块属性问题的代码，问题是这样的，下面的代码是个创建属性块并插入属性块参考的代码，如果块已经创建则直接插入属性块参考，测试发现这段代码可用，但有一个问题无法解决，就是属性块参考插入后块立刻会显示但属性值会过一会都会显示出来，等待的时间不等，在这期间可进行Autocad的各种操作，但此时不能移动该块，否则块的属性位置不跟着移动。请各位高手帮看一下是那里出了问题？谢谢大家了！
Public Function addBG(ByVal insPoint As Point3d, ByVal bnameStr As String)
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim blockId As ObjectId = ObjectId.Null
Dim mrecord As New BlockTableRecord()
mrecord.Name = "JLQBG"
Dim doc As Document = acadApp1.DocumentManager.MdiActiveDocument
Using doc.LockDocument
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)
If bt.Has("JLQBG") = False Then
Dim pt1, pt2 As Point3d
Dim h As Integer = 800
For I As Integer = 0 To 6
If I = 6 Then h = 1500
pt1 = New Point3d(0, h * I, 0)
pt2 = New Point3d(5000, h * I, 0)
Dim kLine As Line = New Line(pt1, pt2)
mrecord.AppendEntity(kLine)
Next
h = 5000
Dim y1, y2 As Integer
For J As Integer = 0 To 2
If J = 0 Then y1 = 0 : y2 = 3200
If J = 1 Then y1 = 3200 : y2 = 4000
If J = 2 Then y1 = 4000 : y2 = 9000
For I As Integer = 0 To 1
pt1 = New Point3d(h * I, y1, 0)
pt2 = New Point3d(h * I, y2, 0)
Dim kLine As Line = New Line(pt1, pt2)
mrecord.Origin = insPoint
mrecord.AppendEntity(kLine)
Next
Next
Dim bzStr()() As String = {New String() {"3350", "边缘构件编号", "GAZ0", "编号"}, _
New String() {"2550", "标高范围", "-0.030~4.470", "标高"}, _
New String() {"1750", "角部钢筋", "8%%13216", "角筋"}, _
New String() {"950", "中部钢筋", "8%%13212", "中筋"}, _
New String() {"150", "箍筋直径间距", "8%%13216", "箍筋"}}
For I As Integer = 0 To 4
Dim attdef As New AttributeDefinition
With attdef
.Position = New Point3d(2500, bzStr(I)(0), 0)
.Height = 450
.Rotation = 0
.WidthFactor = 0.6
.HorizontalMode = TextHorizontalMode.TextCenter
.VerticalMode = TextVerticalMode.TextBottom
.AlignmentPoint = New Point3d(2500, bzStr(I)(0), 0)
.Prompt = bzStr(I)(1)
.TextString = bzStr(I)(2)
.Tag = bzStr(I)(3)
.Invisible = False
.Verifiable = False
.Preset = False
.Constant = False
'.IsMTextAttributeDefinition = True
End With
mrecord.Origin = insPoint
mrecord.AppendEntity(attdef)
Next
blockId = bt.Add(mrecord)
trans.AddNewlyCreatedDBObject(mrecord, True)
End If
trans.Commit()
End Using
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)
Dim blockRef As BlockReference = New BlockReference(insPoint, bt("JLQBG"))
blockRef.ScaleFactors = New Scale3d(1, 1, 1)
blockRef.Rotation = 0
Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
btr.AppendEntity(blockRef)
trans.AddNewlyCreatedDBObject(blockRef, True)
mrecord = trans.GetObject(bt("JLQBG"), OpenMode.ForRead)
Dim iterator As BlockTableRecordEnumerator = mrecord.GetEnumerator()
If mrecord.HasAttributeDefinitions Then
While iterator.MoveNext
Dim obj As DBObject = trans.GetObject(iterator.Current, OpenMode.ForRead)
Dim att As New AttributeReference()
If TypeOf (obj) Is AttributeDefinition Then
Dim attdef As AttributeDefinition = obj
att.SetAttributeFromBlock(attdef, blockRef.BlockTransform)
att.Position = attdef.Position + blockRef.Position.GetAsVector()
Select Case attdef.Tag
Case "编号"
att.TextString = outStr(0)
Case "标高"
att.TextString = outStr(1)
Case "角筋"
att.TextString = outStr(2)
Case "中筋"
att.TextString = outStr(3)
Case "箍筋"
att.TextString = outStr(4)
End Select
If Not blockRef.IsWriteEnabled Then
blockRef.UpgradeOpen()
End If
blockRef.AttributeCollection.AppendAttribute(att)
End If
End While
End If
trans.Commit()
End Using
End Using
db.Dispose()
Return blockId
End Function
沙发...... 没有人帮忙看一下啊？ 请各位大侠帮看一下呀？ 本帖最后由 sailorcwx 于 2011-4-13 12:35 编辑
在blockRef.AttributeCollection.AppendAttribute(att)后面添加trans.AddNewlyCreatedDBObject(att, True) 回复 sailorcwx 的帖子
感谢sailorcwx兄，试过！立即生效！非常感谢，困扰了好久，太感谢了！ 回复 sailorcwx 的帖子
哈哈，我也遇到了这个问题，感谢感谢 学习了多谢 很好，学习了。终于会创建块了。
谢谢。
页:
[1]