有关图形最外围边界生成问题
<p>请教VBA有没有什么方法可以生成图形最处围的边界,因图形内部有多个封闭区域,无法使用CAD的边界命令</p> 取得所有实体的GetBoundingBox，比较得到最大，最小坐标能给一段代码参考一下吗?
<p>能给一段代码参考一下吗?谢谢</p> 本帖最后由 作者 于 2007-1-29 14:25:17 编辑Sub test()
On Error Resume Next
Dim Sset As AcadSelectionSet
Dim i, keyword, KeyStr, MySTr
Dim Pmax, Pmin, IniVar As Variant
Dim x0, y0, x1, y1, dd, ff, la, lb
Dim pt(7) As Double
Dim Pline As AcadLWPolyline
ThisDrawing.SelectionSets("Sset").Delete
Set Sset = ThisDrawing.SelectionSets.Add("Sset")
Sset.SelectOnScreen
Sset(0).GetBoundingBox Pmin, Pmax
x0 = Pmin(0): y0 = Pmin(1)
x1 = Pmax(0): y1 = Pmax(1)
For i = 1 To Sset.Count - 1
Sset(i).GetBoundingBox Pmin, Pmax
If x0 > Pmin(0) Then x0 = Pmin(0)
If y0 > Pmin(1) Then y0 = Pmin(1)
If x1 < Pmax(0) Then x1 = Pmax(0)
If y1 < Pmax(1) Then y1 = Pmax(1)
Next
pt(0) = x0
pt(1) = y0
pt(2) = x1
pt(3) = y0
pt(4) = x1
pt(5) = y1
pt(6) = x0
pt(7) = y1
Set Pline = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)
Pline.Closed = True
End Sub
页:
[1]