确实存在BUG,以下为VBA程序
- Sub DB()
- Dim ent As AcadEntity
- Dim pnt As Variant
- ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "选择对象:"
- DrawBoundingBox ent
- End Sub
- Public Function DrawBoundingBox(ent As AcadEntity) As AcadLWPolyline
- Dim min, max
- ent.GetBoundingBox min, max
- Set DrawBoundingBox = Rectangle(min, max)
- End Function
- Public Function Rectangle(Point1, Point2) As AcadLWPolyline
- Dim vertices(0 To 7) As Double, pl As AcadLWPolyline
- vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
- vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
- vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
- vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))
- Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
- pl.Closed = True
- Set Rectangle = pl
- End Function
绘出的图形: |