[分享]：资料，用VBA炸开块，并把属性转换成文字

XDSoft

How do I explode BlockReferences and convert the attributes to text, using VBA?  
ID    74082  
Applies to:    AutoCAD 2000
AutoCAD 2000I
AutoCAD 2002

Date    7/24/2002  

This document is part of   Attribute   Block Reference   VBA   


Question
Is there an example showing how to explode BlockReferences and convert the attributes
to text?
Answer
Note: This VBA example does not contain error checking. Keep in mind that Attributes
cannot be exploded so they are deleted and text is created at the same location.
Also the explode method explodes the blockReference creating entities but the
blockReference is not deleted. Using the erase method of the selectionset deletes
the blockReferences in this example. The following example assumes a block reference
named "testBlock":


Sub explodeBlkMakeText()
   Dim sset As AcadSelectionSet
   Dim filterType As Variant
   Dim filterData As Variant
   Dim p1(0 To 2) As Double
   Dim p2(0 To 2) As Double
   Dim grpCode(0) As Integer
   Dim grpValue(0) As Variant
   Dim blockRefObj As AcadBlockReference
   Dim explodedObjects As Variant
   Dim I As Integer
   Dim varAttributes As Variant
   Dim strForText As String
   Dim txt As AcadText
   Dim attInsertionPoint As Variant
   Dim dHeight As Double
   
   ' select all blockreferences named testBlock
   Set sset = ThisDrawing.SelectionSets.Add("TestSet")
   grpCode(0) = 2
   filterType = grpCode
   grpValue(0) = "testBlock"
   filterData = grpValue
   sset.Select acSelectionSetAll, p1, p2, filterType, filterData
   
   ' iterate through selectionset
    For Each blockRefObj In sset
       If blockRefObj.HasAttributes = True Then
        
        ' Get the attributes for the block reference
        varAttributes = blockRefObj.GetAttributes
         
         ' Create text entites where the attributes are
         For I = LBound(varAttributes) To UBound(varAttributes)
              strForText = varAttributes(I).TextString
              attInsertionPoint = varAttributes(I).InsertionPoint
              dHeight = varAttributes(I).Height
              ThisDrawing.ModelSpace.AddText strForText, attInsertionPoint, dHeight
         Next
       End If
   
       explodedObjects = blockRefObj.Explode


       ' Loop through the exploded objects
       For I = 0 To UBound(explodedObjects)
         ' delete that attribute definition
         If explodedObjects(I).ObjectName = "AcDbAttributeDefinition" Then
            explodedObjects(I).Delete
         End If


       Next


    Next blockRefObj
  
    'erase the blocks that were exploded
    sset.Erase
    'delete the selectionset
    sset.Delete
End Sub

yingxy1234

好东西，学习了

yjy4519

好东西呀，必须顶

gdkpzsk

请教：不炸开块，如何可循环块中各个元素？谢谢。

LeslieTong

正好是最近需要的，学习了，好东西