本帖最后由 xueliang123 于 2015-1-20 13:46 编辑
- Public Sub createcage()
- Dim dbpoint As Variant
- Dim halfwidth As Double
- Dim Hlength As Double
- Hlength = 110
- Dim outframpoint(0 To 7) As Double
- Dim inframpoint(0 To 7) As Double
- Dim cagecenter(0 To 2) As Double
- Dim cageradius As Double
- halfwidth = 255
- cageradius = 350
- Dim incircle(0 To 0) As AcadCircle
- Dim outcircle(0 To 0) As AcadCircle
- Dim outfram(0 To 0) As AcadEntity
- Dim infram(0 To 0) As AcadEntity
- '用户获取点并赋值以方便以后使用
- dbpoint = ThisDrawing.Utility.GetPoint(, "Select a point")
- cagecenter(0) = dbpoint(0) + 355: cagecenter(1) = dbpoint(1): cagecenter(2) = dbpoint(2)
- With ThisDrawing.ModelSpace
- Set incircle(0) = .AddCircle(cagecenter, cageradius)
- Set outcircle(0) = .AddCircle(cagecenter, cageradius + 5)
-
- '画外框
- outframpoint(0) = dbpoint(0): outframpoint(1) = dbpoint(1) + halfwidth
- outframpoint(2) = dbpoint(0) + Hlength: outframpoint(3) = dbpoint(1) + halfwidth
- outframpoint(4) = dbpoint(0) + Hlength: outframpoint(5) = dbpoint(1) - halfwidth
- outframpoint(6) = dbpoint(0): outframpoint(7) = dbpoint(1) - halfwidth
- Set outfram(0) = .AddLightWeightPolyline(outframpoint)
- outfram(0).Closed = True
- '画内框
- inframpoint(0) = dbpoint(0): inframpoint(1) = dbpoint(1) + halfwidth - 5
- inframpoint(2) = dbpoint(0) + Hlength: inframpoint(3) = dbpoint(1) + halfwidth - 5
- inframpoint(4) = dbpoint(0) + Hlength: inframpoint(5) = dbpoint(1) - halfwidth + 5
- inframpoint(6) = dbpoint(0): inframpoint(7) = dbpoint(1) - halfwidth + 5
- Set infram(0) = .AddLightWeightPolyline(inframpoint)
- infram(0).Closed = True
- '面域图形到
- Dim regions(0 To 3) As Variant
- regions(0) = .AddRegion(outcircle): regions(1) = .AddRegion(incircle)
- regions(2) = .AddRegion(outfram): regions(3) = .AddRegion(infram)
- '将面域复制
- Dim A, B, C, D As AcadRegion
- Set A = regions(0): Set B = regions(1): Set C = regions(2): Set D = regions(3)
- A.Boolean acSubtraction, B: C.Boolean acSubtraction, D
- End With
- End Sub
|