塞特的绝对中心

 Dim objEnt As AcadEntity
 Dim objSS As AcadSelectionSet
 Dim varMinBound As Variant
 Dim varMaxBound As Variant
 Dim minX As Double, maxX As Double
 Dim minY As Double, maxY As Double
 On Error Resume Next
 ThisDrawing.SelectionSets.Item("GetEnt").Delete
 Set objSS = ThisDrawing.SelectionSets.Add("GetEnt")
 objSS.SelectOnScreen
 Set objEnt = objSS(0)
  objEnt.GetBoundingBox varMinBound, varMaxBound
  minX = varMinBound(0): maxX = varMaxBound(0)
  minY = varMinBound(1): maxY = varMaxBound(1)
  For Each objEnt In objSS
   objEnt.GetBoundingBox varMinBound, varMaxBound
   If varMinBound(0) < minX Then minX = varMinBound(0)
   If varMinBound(1) < minY Then minY = varMinBound(1)
   If varMaxBound(0) < maxX Then maxX = varMaxBound(0)
   If varMaxBound(1) < maxY Then maxY = varMaxBound(1)
  Next objEnt
    
  Dim cpt(2) As Double
  cpt(0) = (minX + maxX) / 2
  cpt(1) = (minY + maxY) / 2
  Midpnt = cpt
    
  Dim MoveTopnt As Variant
  MoveTopnt = ThisDrawing.Utility.GetPoint(, "Select Destination Point: ")
  objSS.Move Midpnt, MoveTopnt
    
  objSS.Delete