|
|
最近编制一份投标书，要画一些地层比例图，由于EXCEL一次只能画一个，转到WORD里不好调整，文字大小都不能统一，于是就用VBA编制一个能画饼图的程序，可是在画图例框的时候就出错了，请高的们看看，给小弟仔细点一下。代码如下：
Sub 饼图()
Dim p1() As Double
p1 = ThisDrawing.Utility.GetPoint(, "输入圆心")
Dim sumpercent As Double
sumpercent = 0
Do
On Error GoTo e
Dim per As Double
per = ThisDrawing.Utility.GetReal("输入百分比：")
sumpercent = sumpercent + per
Dim tc As String
tc = ThisDrawing.Utility.GetString(8, "输入土层名称：")
Dim ang As Double
ang = per / 100 * 360
Dim ang1 As Double
Dim ang2 As Double
ang1 = ang / 180 * 3.14159265
ang1 = ang2 + ang1
ang2 = 0
If sumpercent = 100 Then
Call hatch(p1, ang2, 0, per)
Else
Call hatch(p1, ang2, ang1, per)
End If
ang2 = ang1
x = 0
Call legend(p1, tc, x)
x = x + 8
Loop
e:
End Sub
Function legend(basepoint() As Double, stratumname As String, x As Variant) As Double
Dim p(0 To 11) As Double
p(0) = basepoint(0) - 35
p(1) = basepoint(1) - 40 - x
p(2) = 0
p(3) = basepoint(0) - 29
p(4) = basepoint(1) - 40 - x
p(5) = 0
p(6) = basepoint(0) - 29
p(7) = basepoint(1) - 44.8 - x
p(8) = 0
p(9) = basepoint(0) - 35
p(10) = basepoint(1) - 44.8 - x
p(11) = 0
Dim stratum As AcadPolyline
Set stratum = ThisDrawing.ModelSpace.AddPolyline(p)
stratum.Closed = True
Dim addhatch As AcadHatch
Set addhatch = ThisDrawing.ModelSpace.addhatch(0, "solid", True)
addhatch.AppendOuterLoop (stratum) 在这个地方就出错了
Dim insertpoint() As Double
insertpoint(0) = basepoint(0) - 26
insertpoint(1) = basepoint(1) - 44.8 - x
insertpoint(2) = 0
Dim sntext As AcadText
Set sntext = ThisDrawing.ModelSpace.AddText(stratumname, p, 5)
End Function
Function hatch(centerpoint() As Double, startangle As Double, endangle As Double, percent As Double) As Double
Dim outerLoop(0 To 2) As AcadEntity
Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(centerpoint, 30, startangle, endangle)
Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(centerpoint, outerLoop(0).StartPoint)
Set outerLoop(2) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).EndPoint, centerpoint)
Dim text1 As AcadText
Set text1 = ThisDrawing.ModelSpace.AddText(percent & "%", outerLoop(0).EndPoint, 5)
Angle = endangle / 3.14159265 * 360
If Angle
还想请教一下怎么改变填充图案的颜色啊？
|
|
置顶卡
