如何获得整个文档的BoundingBox？

topirol

相当于GetBoundingBox获的对象的矩形边框一样，不过我现在的对象是整个图形文件中所有实体集合的总矩形边框

mccad

选定整个图形做为选择集，然后用以下函数取得两个角点：

2. 
   
3. Public Function ssExtents(ss As AcadSelectionSet) As Variant
   
4. 
   
5.     Dim points(), c As Long
   
6. 
   
7.     Dim min, max, util As AcadUtility
   
8.    
   
9.     Set util = ThisDrawing.Utility
   
10.    
    
11.     c = 0
    
12.    
    
13.     For i = 0 To ss.Count - 1
    
14.         
    
15.         ss.Item(i).GetBoundingBox min, max
    
16.         min = util.TranslateCoordinates(min, acWorld, acUCS, False)
    
17.         max = util.TranslateCoordinates(max, acWorld, acUCS, False)
    
18.         ReDim Preserve points(0 To c + 1)
    
19.         points(c) = min: points(c + 1) = max
    
20.         c = c + 2
    
21.         
    
22.     Next
    
23.         
    
24.     ssExtents = Extents(points)
    
25. 
    
26. End Function
    
27. 
    
28. Public Function Extents(points)
    
29. 
    
30.     Dim min, max
    
31.     Dim i As Long, j As Long, pt, retVal(0 To 1)
    
32.    
    
33.     min = points(LBound(points))
    
34.     max = points(LBound(points))
    
35.         
    
36.     For i = LBound(points) To UBound(points)
    
37.         pt = points(i)
    
38.         For j = LBound(pt) To UBound(pt)
    
39.             If pt(j) < min(j) Then min(j) = pt(j)
    
40.             If pt(j) > max(j) Then max(j) = pt(j)
    
41.         Next
    
42.     Next
    
43.    
    
44.     retVal(0) = min: retVal(1) = max   
    
45.     Extents = retVal
    
46. 
    
47. End Function
    

<br /> Public Function ssExtents(ss As AcadSelectionSet) As Variant<br /> <br />     Dim points(), c As Long<br /> <br />     Dim min, max, util As AcadUtility<br />     <br />     Set util = ThisDrawing.Utility<br />     <br />     c = 0<br />     <br />     For i = 0 To ss.Count - 1<br />         <br />         ss.Item(i).GetBoundingBox min, max<br />         min = util.TranslateCoordinates(min, acWorld, acUCS, False)<br />         max = util.TranslateCoordinates(max, acWorld, acUCS, False)<br />         ReDim Preserve points(0 To c + 1)<br />         points(c) = min: points(c + 1) = max<br />         c = c + 2<br />         <br />     Next<br />         <br />     ssExtents = Extents(points)<br /> <br /> End Function <br /> <br /> Public Function Extents(points)<br /> <br />     Dim min, max<br />     Dim i As Long, j As Long, pt, retVal(0 To 1)<br />     <br />     min = points(LBound(points))<br />     max = points(LBound(points))<br />         <br />     For i = LBound(points) To UBound(points)<br />         pt = points(i)<br />         For j = LBound(pt) To UBound(pt)<br />             If pt(j) < min(j) Then min(j) = pt(j)<br />             If pt(j) > max(j) Then max(j) = pt(j)<br />         Next<br />     Next<br />     <br />     retVal(0) = min: retVal(1) = max    <br />     Extents = retVal<br /> <br /> End Function<br />

efan2000

使用Zoom Extent也是一种方法，这时矩形区域就是窗口的左下角和右上角构成的。它的值可以由系统变量ViewCtr、ViewSize、ScreenSize求的。

topirol

明总的方法可以，E版主的做法我不知道怎么样做，最好有代码嘛：）

mccad

E版的方法可能会由于绘图窗口的长宽不相同而得到不同的结果

efan2000

晕，都告诉你做法了。

2. 
   
3. Sub test()
   
4.     ' 图中没有实体时不做处理
   
5.     If ThisDrawing.ModelSpace.Count = 0 Then Exit Sub
   
6.     ' 按图中实体的最大范围缩放
   
7.     Application.ZoomExtents
   
8.     ' 窗口的中心点坐标
   
9.     Dim cPt As Variant
   
10.     cPt = ThisDrawing.GetVariable("VIEWCTR")
    
11.     ' 窗口的高度
    
12.     Dim h As Double
    
13.     h = ThisDrawing.GetVariable("VIEWSIZE")
    
14.    
    
15.     ' 窗口的宽度
    
16.     Dim w As Double
    
17.     Dim s As Variant
    
18.     s = ThisDrawing.GetVariable("SCREENSIZE")
    
19.     w = h * s(0) / s(1)
    
20.    
    
21.     ' 窗口的左下角和右下角坐标
    
22.     Dim minExt(0 To 2) As Double
    
23.     Dim maxExt(0 To 2) As Double
    
24.     minExt(0) = cPt(0) - w / 2: minExt(1) = cPt(1) - h / 2: minExt(2) = 0
    
25.     maxExt(0) = cPt(0) + w / 2: maxExt(1) = cPt(1) + h / 2: maxExt(2) = 0
    
26. End Sub
    

<br /> Sub test()<br />     ' 图中没有实体时不做处理<br />     If ThisDrawing.ModelSpace.Count = 0 Then Exit Sub<br />     ' 按图中实体的最大范围缩放<br />     Application.ZoomExtents<br />     ' 窗口的中心点坐标<br />     Dim cPt As Variant<br />     cPt = ThisDrawing.GetVariable("VIEWCTR")<br />     ' 窗口的高度<br />     Dim h As Double<br />     h = ThisDrawing.GetVariable("VIEWSIZE")<br />     <br />     ' 窗口的宽度<br />     Dim w As Double<br />     Dim s As Variant<br />     s = ThisDrawing.GetVariable("SCREENSIZE")<br />     w = h * s(0) / s(1)<br />     <br />     ' 窗口的左下角和右下角坐标<br />     Dim minExt(0 To 2) As Double<br />     Dim maxExt(0 To 2) As Double<br />     minExt(0) = cPt(0) - w / 2: minExt(1) = cPt(1) - h / 2: minExt(2) = 0<br />     maxExt(0) = cPt(0) + w / 2: maxExt(1) = cPt(1) + h / 2: maxExt(2) = 0<br /> End Sub<br />

请参照下面的方法，上面的示例权且做为获取当前窗口坐标范围的例子吧。

myfreemind

缩放全图之后用extmin,extmax
我觉得更方便！

efan2000

确实，这两个系统变量给忘了，我倒有点绕弯路了，而且只是取窗口坐标，当图形没有向四面刚好填满时，会比计算值的大，因而并不是最小的包含矩形。大家不要采用上面的方法，以免误导。

2. 
   
3. Sub test()
   
4. 
   
5.     ' 图中没有实体时不做处理
   
6.     If ThisDrawing.ModelSpace.Count = 0 Then Exit Sub
   
7.    
   
8.     ' 按图中实体的最大范围缩放
   
9.     Application.ZoomExtents
   
10.    
    
11.     ' 窗口的左下角和右下角坐标
    
12.     Dim minExt As Variant
    
13.     Dim maxExt As Variant
    
14.     minExt = ThisDrawing.GetVariable("EXTMIN")
    
15.     maxExt = ThisDrawing.GetVariable("EXTMAX")
    
16. End Sub
    

<br /> Sub test()<br /> <br />     ' 图中没有实体时不做处理<br />     If ThisDrawing.ModelSpace.Count = 0 Then Exit Sub<br />     <br />     ' 按图中实体的最大范围缩放<br />     Application.ZoomExtents<br />     <br />     ' 窗口的左下角和右下角坐标<br />     Dim minExt As Variant<br />     Dim maxExt As Variant<br />     minExt = ThisDrawing.GetVariable("EXTMIN")<br />     maxExt = ThisDrawing.GetVariable("EXTMAX")<br /> End Sub<br />

topirol

呵呵，由于用Zoom Extent后，我的整体图形不一定刚好布满界面（长宽比不一定和CAD界面的一样），所以用E版主的算法得出的结果范围偏大。

明总的做法可以得到准确边框，但如果实体太多的话，就显得很慢了，不知道有没有更好的算法呢？

bluemoon

如果图形没有出现大图套小图，也就是图形互不干涉 可以用
thisdrawing.sendcommand "region all  "
thisdrawing.sendcommand "union all  "
此时就只有一个thisdrawing.modelspace.count 了 可以直接得到啊
呵呵 当然 此法的限制条件太严了 不利于得到角点以后的操作