社区 › VB › Sset的绝对中心

Bryco 发表于 2008-7-6 16:19:09

Sset的绝对中心

无论选择集中有多少个实体，都有可能获得选择集的绝对中点吗
谢谢你

Atook 发表于 2008-7-6 16:46:53

希望这会让你开始Option Explicit
Sub GetSelectionCenter()
   Dim oSset As AcadSelectionSet
   Dim oEnt As AcadEntity
   Dim xmin As Double, xmax As Double
   Dim ymin As Double, ymax As Double
   Dim i As Integer
   Dim lp(0 To 2) As Double
   Dim up(0 To 2) As Double
   
          With ThisDrawing.SelectionSets
               While .Count > 0
                  .Item(0).Delete
               Wend
          Set oSset = .Add("TestSet")
          End With
   oSset.SelectOnScreen
   ReDim xcoords(0 To (oSset.Count - 1) * 2) As Double
   ReDim ycoords(0 To (oSset.Count - 1) * 2) As Double
For Each oEnt In oSset
    Dim minExt As Variant
    Dim maxExt As Variant
    oEnt.GetBoundingBox minExt, maxExt
    xcoords(i) = minExt(0): xcoords(i + 1) = maxExt(0)
    ycoords(i) = minExt(1): ycoords(i + 1) = maxExt(1)
    i = i + 1
Next
xmin = SortDesc(xcoords)(0): ymin = SortDesc(ycoords)(0)
xmax = SortAsc(xcoords)(0): ymax = SortAsc(ycoords)(0)
lp(0) = xmin: lp(1) = ymin: lp(2) = 0#
up(0) = xmax: up(1) = ymax: up(2) = 0#
Dim minPt As Variant
Dim maxPt As Variant
Dim cpt As Variant
Dim centPt(2) As Double
With ThisDrawing.Utility
minPt = .TranslateCoordinates(lp, acUCS, acWorld, False)
maxPt = .TranslateCoordinates(up, acUCS, acWorld, False)
centPt(0) = (minPt(0) + maxPt(0)) / 2: centPt(1) = (minPt(1) + maxPt(1)) / 2: centPt(2) = 0#
cpt = .TranslateCoordinates(centPt, acUCS, acWorld, False)
End With
'for visualization only:
Dim oCirc As AcadCircle
Set oCirc = ThisDrawing.ModelSpace.AddCircle(cpt, 10)
oCirc.color = acRed
ZoomWindow minPt, maxPt
End Sub
Public Function SortAsc(SourceArr As Variant) As Variant
      Dim Check As Boolean
      Dim Elem As Double
      Dim iCount As Integer
      Check = False
      Do Until Check
      Check = True
      For iCount = LBound(SourceArr) To UBound(SourceArr) - 1
      If SourceArr(iCount)SourceArr(iCount + 1) Then
      Elem = SourceArr(iCount)
      SourceArr(iCount) = SourceArr(iCount + 1)
      SourceArr(iCount + 1) = Elem
      Check = False
      End If
      Next
      Loop
      
SortDesc = SourceArr
End Function
~&039；J#039~

Atook 发表于 2008-7-8 02:18:04

修复，
我需要仔细看看这个
很可能与当地人一起运行它，看看到底发生了什么。我有一些类似的东西，但没有那么复杂。谢谢你，我会看一看

Bryco 发表于 2008-7-8 06:22:17

“嗯，”；中心“；通常是指圆-我假设你是指包含所有选定实体的多边形的中间…在这种情况下，你&#039；d需要比已经发布的代码更多的代码和更复杂的代码
但是如果你想找一个又快又脏的函数，这里有一个小函数，它平均传递给它的选择集的边界框的x/y----------------------------------------------------
函数SsCenter（对象设置为AcadSelectionSet）作为变量&nbsp；Dim MinPoint、MaxPoint作为变体&nbsp&nbsp&nbsp' 用于BBox回叫&nbsp；Dim I As Long，objCount As Long&nbsp&nbsp&nbsp&nbsp' 各种计数器&nbsp；Dim retPoint（1）为双精度&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp' 函数返回中心的XY&nbsp；Dim TotalX为双精度，TotalY为双精度' 即时统计平均值&nbsp
&nbsp' 确保将体面的东西作为参数传递&nbsp；如果objSset为Nothing，则退出函数&nbsp' 确保我们有SelSet&nbsp；objCount=objSset。计数&nbsp；如果objCount=0，则退出函数&nbsp&nbsp&nbsp&nbsp' 确保有#039；选择集中有一些东西&nbsp' 循环并获得每个实体的最小/最大值&nbsp；对于I=0到objCount-1' 循环和抓取边界框&nbsp&nbsp&nbsp；对象集。项目（I）。GetBoundingBox最小点、最大点&nbsp&nbsp&nbsp；TotalX=TotalX+MinPoint（0）+MaxPoint（零）&nbsp&nbsp&nbsp；TotalY=TotalY+MinPoint（1）+MaxPoint（一）&nbsp；下一步&nbsp
&nbsp' 生成x/y平均值的2索引安全数组&nbsp；retPoint（0）=TotalX/（objCount*2）：retPoint（1）=Total/（objCount*2）&nbsp' 将其作为变体返回&nbsp；SsCenter=retPoint结束函数

Atook 发表于 2008-7-8 10:46:18

两种方法都不适用于&#039；t工作

Atook 发表于 2008-7-8 10:59:28

这有助于完成手头的任务
这是#039的定义吗；中心#039；即#039；这是一个问题，或者说代码没有#039；t跑步

Atook 发表于 2008-7-8 14:36:05

我在寻找整个选择集的绝对中心
例如，假设从左下角点到最右上角点的所有实体（边界框）都是0,0到50,50，那么我希望设置一个变量来拾取点25,25，一旦抓取该点，那么我可以将整个sset定位到需要的位置
因此，我希望它能够发挥作用，无论它是一个实体还是15个实体；我试了又试，但还是不走运
我认为（如果我知道一种方法）将最近边界框的左下角点（x和y）取为0,0，以及距离0,0最远的边界框的右上角点（x和y），然后将这两个点除以2，这应该会给出所需的答案
问题是，我如何获得这些值
谢谢CADR

Bryco 发表于 2008-7-8 15:16:51

啊，最后一件事；我认为我的方法（口头）是有道理的，但有一个值得考虑；也就是说，如果一个边界框#039；s点为-（neg）0,0
我想，我们首先需要检查一个值是否为&lt；然后取0,0，然后取负0,0方向上的最远点作为起点，仍然取从0,0开始的最远的点作为需要除以2的点。边界框LL+UR/2，如果有人有一种方法可以得到这4个点（x和y），我想我可以做其余的

Bryco 发表于 2008-7-8 17:56:24

又快又脏的方式我&#039；d得到这些值，看起来像..Public Function ReturnMid(objSS As AcadSelectionSet) As Variant
    Dim objEnt As AcadEntity
    Dim varMinBound As Variant
    Dim varMaxBound As Variant
    Dim minX As Double
    Dim minY As Double
    Dim maxX As Double
    Dim maxY As Double
   
    Set objEnt = objSS(0)
    objEnt.GetBoundingBox varMinBound, varMaxBound
    minX = varMinBound(0): minY = varMinBound(1)
    maxX = varMaxBound(0): 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
    'calculate midpt, have kettle call pot black, etc..
    '???
    'PROFIT!!
End Function

Atook 发表于 2008-7-8 23:07:58

是的，你&#039；你说得对，我的问题你能解决吗
~&#039；J#039~

查看完整版本: Sset的绝对中心