'PKPM字体调整
Sub PKPM_Text1()
    
    Dim objSelected As Object
    Dim strPrompt As String
    Dim acText As AcadText
    Dim ssText As AcadSelectionSet
    
    Dim Pmax As Variant
    Dim Pmin As Variant
    Dim PCenter As Variant
    On Error Resume Next
    
    Set ssText = ThisDrawing.SelectionSets.Add("Text")

    '定义过滤机制
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    filterType(0) = 0
    filterData(0) = "TEXT"
    
    ssText.SelectOnScreen filterType, filterData

    '对选择集中的文字对象进行操作
    For Each objSelected In ssText
        If TypeOf objSelected Is AcadText Then
            Set acText = objSelected
            acText.GetBoundingBox Pmin, Pmax
            PCenter = CenterPoint(Pmin, Pmax)

            acText.Alignment = acAlignmentMiddleCenter
            acText.Move acText.TextAlignmentPoint, PCenter
            acText.ScaleFactor = 0.7
            
        Else
            '删除选择集
            ThisDrawing.SelectionSets.item("Text").Delete
        End If
    Next
    
    ThisDrawing.SelectionSets.item("Text").Delete
    ThisDrawing.Application.Update
    
    Exit Sub
    
ErrControl:
    MsgBox Err.Description
End Sub