向每个b添加新属性
大家好，如何在该图形中搜索没有名为“Handle\u ID”属性的块。如果没有，则在块中添加贡品。
我得到了这个：
Sub test2()
Dim attributeObj As AcadAttribute
Dim BlockObj As AcadBlockReference
Dim BlockObj2 As AcadBlock
For Each Elem In ThisDrawing.ModelSpace
With Elem
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If ((Elem.HasAttributes) And (Left(Elem.EffectiveName, 3) = "G_B") Or (Left(Elem.EffectiveName, 3) = "G_E") Or _
(Left(Elem.EffectiveName, 3) = "G_I") Or (Left(Elem.EffectiveName, 3) = "G_L")) Then
Handle = Elem.Handle
Dim InsertionPnt(0 To 2) As Double
InsertionPnt(0) = 0#: InsertionPnt(1) = 0#: InsertionPnt(2) = 0#
Set BlockObj = Elem
Set BlockObj2 = BlockObj <-FIRST ERROR)
Set attributeObj = BlockObj2.AddAttribute(1, acAttributeModeInvisible, "HANDLE_ID", InsertionPnt, "HANDLE_ID", Handle) <-SECOND ERROR)
ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & Elem.EffectiveName & vbCr
End If
End If
End With
Next Elem
End Sub
或
Set BlockObj2= ThisDrawing.Blocks(BlockObj.Name)
对于动态块
HTH公司
~'J'~
谢谢你的回复。但是你能把它放在一个工作过程中，同时检查Handle\u ID是否存在吗？如果没有，它会被添加到块中？
您需要检查现有的属性名（TagString）
而不是检查手柄
只需迭代属性-请参阅帮助文件中的Gettributes
这个论坛上也有很多代码示例
从另一方面来说，你可以用过滤器代替选择
通过所有图形对象循环
对不起，我现在没有足够的时间为您编写完整的解决方案
~'J'~ 好的，我有几分钟的时间，所以我试着写得又快又脏
只是我无法在没有动态块的情况下测试它
希望这能让你有所了解
Set BlockObj2= ThisDrawing.Blocks(BlockObj.EffectiveName)
~'J'~ Thnx！我也尝试了一些东西，它也有效。。。我想我一点也不差：眨眼：
Option Explicit
Sub test2()
Dim attributeObj As AcadAttribute
Dim BlockObj As AcadBlockReference
Dim BlockObj2 As AcadBlock
Dim elem As AcadEntity
Dim Handle As String
Dim blockName As String
Dim collNames As New Collection
Dim i As Integer
Dim j As Integer
'collect just unique block names into collection
For Each elem In ThisDrawing.ModelSpace
If (TypeOf elem Is AcadBlockReference) Then
Set BlockObj = elem
With BlockObj
If ((.HasAttributes) And (Left(.EffectiveName, 3) = "G_B") Or (Left(.EffectiveName, 3) = "G_E") Or _
(Left(.EffectiveName, 3) = "G_I") Or (Left(.EffectiveName, 3) = "G_L")) Then
On Error Resume Next ' to bypass error on duplicate name
collNames.Add .EffectiveName, .EffectiveName
End If
End With
End If
Next elem
Dim InsertionPnt(0 To 2) As Double
InsertionPnt(0) = 0#: InsertionPnt(1) = 0#: InsertionPnt(2) = 0#
' iterate trough collection
For i = 1 To collNames.Count
blockName = collNames.Item(i)
Set BlockObj2 = ThisDrawing.Blocks(blockName)
Set attributeObj = BlockObj2.AddAttribute(1, acAttributeModeInvisible, "New prompt", InsertionPnt, "NEW_TAG", "0")
With ThisDrawing
.SetVariable "CMDECHO", 0
.SendCommand "_ATTSYNC _N " & blockName & vbCr
.SetVariable "CMDECHO", 1
.Regen acAllViewports
End With
Next i
ThisDrawing.Regen acAllViewports
Dim ftype(1) As Integer
ftype(0) = 0: ftype(1) = 2
Dim fdata(1) As Variant
fdata(0) = "INSERT"
' iterate trough collection again
For i = 1 To collNames.Count
blockName = collNames.Item(i)
fdata(1) = "`*," & blockName
Dim oSset As AcadSelectionSet
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
oSset.Select acSelectionSetAll, , , ftype, fdata
For Each elem In oSset
Set BlockObj = elem
Handle = elem.Handle
Dim atts() As AcadAttributeReference
Dim att As AcadAttributeReference
With BlockObj
atts = .GetAttributes()
For j = 0 To UBound(atts)
Set att = atts(j)
If att.TagString = "NEW_TAG" Then
att.TextString = CStr(Handle)
'//Exit For
End If
Next j
Exit For
End With
Next elem
'//oSset.Delete
Next i
MsgBox "Get to work!"
End Sub
只是看起来比你的简单多了 格伦科，
这个线程似乎与线程“句柄出了什么问题？”
这些线程中讨论的问题，以及RK McSwain发布的问题，对于任何试图将AutoCAD图形协调到外部数据库的人来说都很重要。
我要说的是，上面发布的过程是解决非持久性句柄问题的一种聪明方法，但令人沮丧的是，接受这样一个问题实际上存在。定制文档始终声明句柄在文档中是唯一的，并且保持不变。
我不怀疑你关于绘图和数据库之间协调中断的说法；然而，如果发生这种中断的图形中有一些共同的元素，则会带来一些安慰。
发生和未发生的地方有什么不同吗？ 那个http://discussion1.autodesk.com/forums/thread.jspa?threadID=729961link，尽管有着相当对立的基调（或者我应该说泛音），但它提供了相当丰富的信息，并列出了几个可能导致手柄改变的原因。
WBLOCKing当然是一个很可能的候选者，并且可以在不太困难的情况下解决。
也：
恢复可能是另一个可能的原因，尽管如果这真的改变了手柄，我会有点恼火。
如果重新处理不是文档范围的，即只有图形的一个子集在更改，然后进行剪切和粘贴，甚至Lisp/VBA等，则可能需要检查程序。 我唯一知道的是，图形中的所有句柄都已更改，但我无法复制它。这并不经常发生。只有我的一些同事。可能是在他们做一些不寻常的事情时。
我正忙于重建VBA例程，因为它对动态块的处理速度很慢，并且一些功能不能正常工作。我们还认为这是导致数据库空的原因。除了，这件事也发生在我身上！
如果你看附上的图片，你可以看到我的数据库是如何填写的。我只在图形中有新项（新句柄）时才向其添加记录。
注2的记录=！！删除！！是在图形中找不到的具有句柄（数据库中的唯一对象ID）的项。因此，如果我删除一个项目，数据库会将Note_2设置为！！删除！！。您可以看到，对于第一条记录（Object_ID=1A83B），类型和组为“P”和“355”。这是他的原始手柄的原始项目。
一些关于如何将手柄更改为1C431的信息。我从来没有复制、剪切、粘贴、wblock或其他什么。它是同一个图形中未更改的块。当我的数据库更新时，更改的句柄被视为新数据库，因此它将其添加到自身中。您可以在该记录中找到“P”和“355”，因为它们是根据该特定块的属性添加的。这个项目在我的画作中只有一次。
如您所见，每个项目都会发生这种情况，并将其再次添加到数据库中。其他信息（描述、供应商类型等）添加到数据库中，因此该数据不会添加到新记录中。
在我重建例程之前，我们不知道问题的原因，因为记录会立即从数据库中删除。现在我知道了问题所在（更改了句柄），所以我想通过将每个项添加到其自己的属性和数据库中来备份其句柄。现在我可以检查是否有更改的句柄。如果有，则用新句柄替换原始记录。
如果我构建正确，就不会有更多的空数据库，但还有一件事要做。。。为什么/什么时候我的把手变了？？
你让我警觉起来。我已经设计了一个基于不变手柄的游戏计划，但现在将密切关注它。
坦率地说，基于Tony Tanzillo在Autodesk中提出的一些问题，我希望保持原样。讨论链接。最主要的是，在不复制ID的情况下复制对象的能力。如果在初始数据库构建之后执行额外工作，这是一个重要问题。
我确实想到了一件事，可以用Handle属性方法检查。仅仅向块/块引用添加额外属性的行为是否会改变实体的句柄？这可能与区块有关；参考文献可能没有这么多。
如果我正确理解你的意思。
AddAttribute操作是在我发现句柄已更改后添加的。即使很难，当我使用addattribute时，块的句柄保持不变。
可以肯定的是：我对属性的句柄不感兴趣。我对包含几个属性的块his handle感兴趣。
页:
[1]
2