[编程交流] 通过vb向块添加属性

Public strMyBlockName As String
Sub SelSet_FindBlockName_StoreName()
   Dim MyBlockRef As AcadBlockReference
   Dim I As Double
   Dim MyoEnt As AcadEntity
   Dim MyAttTextStr As String
   On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
       Set objSS = ThisDrawing.SelectionSets.Add("SelectBlock")
       '' let user select entities interactively
       objSS.SelectOnScreen
        'MyObjSS.SelectOnScreen FilterType, FilterData
        'MyObjSS.Select acSelectionSetAll 'FilterType, FilterData
       '' highlight the selected entities
       objSS.Highlight True
       
 
       
       
       '' pause for the user
       '.Prompt vbCr & objSS.Count & " entities selected"
       '.GetString False, vbLf & "Enter to continue "
       For Each MyoEnt In objSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
                     strMyBlockName = MyBlockRef.Name
                     
           End If
       Next
End With
    
                           MyOldBlockObjSS.Erase
      
     Call Add_Att
      
      
  End Sub
Sub Add_Att()
   
   
  ' This example creates an attribute definition in a block.
   ' It then inserts the block. Then it changes the prompt string
   ' of the attribute definition, and inserts the block again.
   
   Call MakeStringUppercase
   
   ' Create the block
   Dim blockobj As AcadBlock
   Dim insertionPnt1(0 To 2) As Double
   Dim insertionPnt2(0 To 2) As Double
  ' insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
   'Set blockObj = ThisDrawing.Blocks.Add(insertionPnt1, "SFG101")
   
   Set blockobj = ThisDrawing.Blocks.Add(insertionPnt1, strMyBlockName)
   
   ' Define the attribute definition
   Dim attributeObj As AcadAttribute
   Dim height As Double
   Dim mode As Integer
   Dim prompt As String
   Dim tag As String
   Dim value As String
   
   height = 5
   mode = acAttributeModeNormal
       
       tag1 = "Part_No"
       prompt1 = "What is the Part No?"
       value1 = strMyBlockName
       insertionPnt1(0) = 5#: insertionPnt1(1) = 5: insertionPnt1(2) = 0
   ' Create the attribute definition on the block
       Set attributeObj = blockobj.AddAttribute(height, mode, prompt1, insertionPnt1, tag1, value1)
           
           
           
   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & strMyBlockName & vbCr
'Call SelSet_FindBlockName_StoreName
  ' ZoomAll
End Sub