[已解决]如何得到选择的多个对象的共同中心点呢？

nhy12345678

我知道一个函数，给任用一个实体绘制边框，可是如何得到实体的中心点呢？

Public Function DrawBoundingBox(ent As AcadEntity) As AcadLWPolyline

    Dim Min, Max
    
    ent.GetBoundingBox Min, Max
    Set DrawBoundingBox = Rectangle(Min, Max)

End Function

nhy12345678

得到一个方法，但只能选择1个对象或一个块,同时选择多个对象时想得到中心点还请大家帮帮忙

Public Function GetEntMidPoint(ent As AcadEntity) As Variant '获得对象的中心点
    Dim min, max
    ent.GetBoundingBox min, max
    GetEntMidPoint = Array((min(0) + max(0)) / 2, (min(1) + max(1)) / 2, (min(2) + max(2)) / 2)
End Function

nhy12345678

已经解决了！思路为先得到每个对象的min max数字，在比较其他对象的min max值，遍历所有对象后得到所有对象的最大值和最小值，从而得到共同的中心点，哈哈感谢明经通道。代码如下：

Public xmin(0 To 2) As Double
Public ymax(0 To 2) As Double

Public Function GetEntMaxmin(ent As AcadEntity) As Variant '获得对象的最大值最小值
    Dim min, max
    ent.GetBoundingBox min, max
    xmin(0) = min(0): xmin(1) = min(1): xmin(2) = 0
    ymax(0) = max(0): ymax(1) = max(1): ymax(2) = 0
End Function

Sub dxjzY() '让选择的对象居中
Dim obj() As AcadEntity
Dim ent As AcadEntity
Dim ss As AcadSelectionSet
Dim midd(0 To 2) As Double
Dim mid2(0 To 2) As Double
Dim minmin(0 To 2) As Double
Dim maxmax(0 To 2) As Double
Dim i As Long
Set ss = ThisDrawing.SelectionSets.Add("sss")
ss.SelectOnScreen
ReDim obj(0 To ss.Count - 1) As AcadEntity
For Each ent In ss
    Set obj(i) = ent
    i = i + 1
Next
GetEntMaxmin obj(0)
minmin(0) = xmin(0): minmin(1) = xmin(1): minmin(2) = 0
maxmax(0) = ymax(0): maxmax(1) = ymax(1): maxmax(2) = 0
For i = 1 To ss.Count - 1
   Set obj(i) = ss.Item(i)
   GetEntMaxmin obj(i)
   If minmin(0) > xmin(0) Then minmin(0) = xmin(0)
   If minmin(1) > xmin(1) Then minmin(1) = xmin(1)
   If maxmax(0) < ymax(0) Then maxmax(0) = ymax(0)
   If maxmax(1) < ymax(1) Then maxmax(1) = ymax(1)
Next i
'midd为选择一系列对象的中心点
midd(0) = (minmin(0) + maxmax(0)) * 0.5
midd(1) = (minmin(1) + maxmax(1)) * 0.5
midd(2) = 0
ss.Delete
End Sub

robbin840311

请LZ关注下

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=68254