[编程交流] 在Autocad中选择“块”，然后重新选择

Private Sub Change_it()
   Dim obj As AcadBlockReference
   Dim inspt As Variant
   ThisDrawing.Utility.GetEntity obj, inspt, "Select object:"
   ' Checks if you selected a block.
   If obj.ObjectName = "AcDbBlockReference" Then
       ' Check for attributes.
       If obj.HasAttributes Then
           Dim AttList As Variant
           ' Build a list of attributes for the current block.
           AttList = obj.GetAttributes
           ' Cycle throught the list of attributes.
           For I = LBound(AttList) To UBound(AttList)
               ' Check for the correct attribute tag.
               If AttList(I).TagString = "Z" Then
                   Dim InputString As String
                   ' Get the new value for the attribute.
                   InputString = ThisDrawing.Utility.GetString(True, "New value for z: ")
                   ' Set the new value for the attribute.
                   AttList(I).TextString = InputString
               End If
           Next
       End If
   Else
       MsgBox "You did not select a block."
   End If
End Sub

Public Sub ModifyLabelSTNcoords()
' adds x and y co ords of picked point to labelstn block
Dim objENT As AcadEntity
Dim pt1 As Variant
Dim attribs As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity objENT, basepnt, "pick Label stn block : "
         attribs = objENT.GetAttributes
pt1 = ThisDrawing.Utility.GetPoint(, " pick stn point")
txtx1 = "E " + CStr(FormatNumber(pt1(0), 3))
TXTY1 = "N " + CStr(FormatNumber(pt1(1), 3))
TXTz1 = "RL " + CStr(FormatNumber(pt1(2), 3))
attribs(2).TextString = txtx1
attribs(2).Update
attribs(3).TextString = TXTY1
attribs(3).Update
attribs(4).TextString = TXTz1
attribs(4).Update
End Sub