[已解决]如何得到选择的多个对象的共同中心点呢？
我知道一个函数，给任用一个实体绘制边框，可是如何得到实体的中心点呢？Public Function DrawBoundingBox(ent As AcadEntity) As AcadLWPolyline
Dim Min, Max
ent.GetBoundingBox Min, Max
Set DrawBoundingBox = Rectangle(Min, Max)
End Function
得到一个方法，但只能选择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
已经解决了！思路为先得到每个对象的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)
请LZ关注下
页:
[1]