[编程交流] 属性将值更改为mat

Option Explicit
Public Sub DtlValUpdate()
Dim strDrawingName As String, vardata(1) As Variant, intType(1) As Integer, varAtts As Variant
Dim objSelSet As AcadSelectionSet, objBlockRef  As AcadBlockReference, i As Integer, objAttRef As AcadAttributeReference
strDrawingName = (Left(ThisDrawing.Name, (Len(ThisDrawing.Name) - 4)))
intType(0) = 0
vardata(0) = "INSERT"
intType(1) = 2
vardata(1) = "DT-IDLABEL"
ACADSelSet objSelSet, "UPDateDtl"
objSelSet.Select Mode:=acSelectionSetAll, FilterType:=intType, FilterData:=vardata
For Each objBlockRef In objSelSet
     If objBlockRef.HasAttributes Then
     varAtts = objBlockRef.GetAttributes
           For i = LBound(varAtts) To UBound(varAtts)
           Set objAttRef = varAtts(i)
                 If objAttRef.TagString = "DNO#" Then
                       objAttRef.TextString = strDrawingName
                       Exit For
                 End If
           Next i
     End If
Next objBlockRef
End Sub
Public Function ACADSelSet(funcObjSelSet As AcadSelectionSet, funcSelectionSetName As String)
     Dim objSelCol As AcadSelectionSets
     On Error GoTo Err_Control
     Set objSelCol = ThisDrawing.SelectionSets
     For Each funcObjSelSet In objSelCol
     If funcObjSelSet.Name = funcSelectionSetName Then
     funcObjSelSet.Clear
     funcObjSelSet.Delete
     Exit For
     End If
     Next
     Set funcObjSelSet = objSelCol.Add(funcSelectionSetName)
Exit_Here:
     Exit Function
Err_Control:
     Select Case Err.Number
     Case -2145386300
     MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
     Case Else
     MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
     End Select
End Function