如何修改成圆环(donut)-付源代码

kevinchan

mccad发表于2004-11-17 21:41:00把圆直接改成圆环，是不可能的。只有通过读取圆的属性，(如圆心位置及半径)，然后删除，重新按照其大小生成圆环。

针对上面的源代码,应加怎样的代码来读取和生成呢?

雪山飞狐_lzh

Sub test()
On Error Resume Next
Dim ss As AcadSelectionSet
ThisDrawing.SelectionSets("Test").Delete
Set ss = ThisDrawing.SelectionSets.Add("Test")
Dim ft(0) As Integer, fd(0)
ft(0) = 0: fd(0) = "Circle"
ss.SelectOnScreen ft, fd
For Each i In ss
Cir2LW i, 1
Next i
End Sub Sub Cir2LW(ByVal oCircle, ByVal Width As Double)
Dim pnt
Dim r As Double
Dim pnts(3) As Double
Dim oLW As AcadLWPolyline
pnt = oCircle.Center
r = oCircle.radius
pnts(0) = pnt(0) - r: pnts(1) = pnt(1)
pnts(2) = pnt(0) + r: pnts(3) = pnt(1)
Set oLW = ThisDrawing.ModelSpace.AddLightWeightPolyline(pnts)
oLW.Closed = True
oLW.SetBulge 0, 1
oLW.SetBulge 1, 1
oLW.SetWidth 0, Width, Width
oLW.SetWidth 1, Width, Width
oLW.Update
oCircle.Delete
End Sub

mccad

你的程序只需把Set circ = ThisDrawing.ModelSpace.AddCircle(centerpt, radius)
改成6楼所说的方法就可以了，这应该很容易完成，又何必在画完圆后再改成圆环呢？

kevinchan

恩， 谢谢!!!

kevinchan

我刚才试了改不成功,偶比较菜,老大可以帮我修改一下源码吗?


谢谢!

雪山飞狐_lzh

加一个函数 Sub AddDonut(ByVal Center, ByVal Radius As Double, ByVal Width As Double)
Dim oLW As AcadLWPolyline
Dim pnts(3) As Double
pnts(0) = Center(0) - Radius: pnts(1) = Center(1)
pnts(2) = Center(0) + Radius: pnts(3) = Center(1)
Set oLW = ThisDrawing.ModelSpace.AddLightWeightPolyline(pnts)
oLW.Closed = True
oLW.SetBulge 0, 1
oLW.SetBulge 1, 1
oLW.SetWidth 0, Width, Width
oLW.SetWidth 1, Width, Width
oLW.Update
End Sub 把 Set circ = ThisDrawing.ModelSpace.AddCircle(centerpt, radius) 改为 AddDonut centerpt,radius, 1

kevinchan

搞定,非常感谢lzh和mccad的帮忙!