有关块属性的读取

tonyhuangg · 发表于 2004-10-14 17:03:00

再次麻烦版主了,lzh741206
知道块名：a；块属性标记：如图号的属性标记值为：th；
如何快速找到这个块，并把图号的属性标记值为th的文字内容读出来，我用vb6.0，引用object cad 2004库，请列出源代码，谢谢！

王咣生 · 发表于 2004-10-15 00:10:00

依据块名作选择集; 然后用下面方法得到属性:
   ' Get the attributes for the block reference
   Dim varAttributes As Variant
   varAttributes = blockRefObj.GetAttributes

   Dim strAttributes As String
   Dim I As Integer
   For I = LBound(varAttributes) To UBound(varAttributes)
   strAttributes = strAttributes & "    Tag: " & varAttributes(I).TagString & _
   "    Value: " & varAttributes(I).textString & "    "
   Next

tonyhuangg · 发表于 2004-10-15 09:05:00

依据块名作选择集,怎么做，谢谢

雪山飞狐_lzh · 发表于 2004-10-15 09:08:00

(entget(car(entsel)))
命令行键入，选择一个块看看结果

王咣生 · 发表于 2004-10-15 09:22:00

作选择集:
Public Sub test()
   ' Create the selection set
   Dim ssetObj As AcadSelectionSet
   Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
   Dim mode As Integer
   mode = acSelectionSetAll

   ' Add all the Circles to the selection set that lie within the crossing of (28,17,0) and
   ' (-3.3, -3.6,0) by filtering from the current drawing
   Dim gpCode(0 To 1) As Integer
   Dim dataValue(0 To 1) As Variant
   gpCode(0) = 0
   dataValue(0) = "Insert"
   gpCode(1) = 2
   dataValue(1) = "a"    '块名

   Dim groupCode As Variant, dataCode As Variant
   groupCode = gpCode
   dataCode = dataValue

   ssetObj.Select mode, , , groupCode, dataCode
   MsgBox ssetObj.Count

   '然后你循环ssetObj中的每个块实体...
End Sub

王咣生 · 发表于 2004-10-15 18:15:00

这样吧: Sub test()
   Dim blks As AcadBlocks
   Dim blk As AcadBlock

   Set blks = ThisDrawing.Blocks

   Set blk = blks.Item("a")

   Dim i As Integer

   For i = 0 To blk.Count - 1
   Dim obj As AcadObject
   Set obj = blk.Item(i)
   Dim str As String
   str = obj.ObjectName
   If obj.ObjectName = "AcDbAttributeDefinition" Then
   Dim attrObj As AcadAttribute
   Set attrObj = obj
   Dim tag, prompt, value As String
   tag = attrObj.TagString
   prompt = attrObj.PromptString
   value = attrObj.TextString
   MsgBox "Tag: " & tag & vbCr & "Value: " & value & vbCr & "Value: " & value & vbCr
   End If
   Next

End Sub
测试dwg:

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载