复制的关于AddHatch的例子,为何不能运行??
我复制的AutoCAD VBA帮助中的例子(AppendOuterLoop ),为什么不能运行?能帮我看看吗?这是个填充半圆的例子. 倒数第二行(hatchObj.Evaluate)语句总是不能运行.
------------------------------------
Sub Example_AppendOuterLoop()<BR> ' This example creates an associative hatch in model space.<BR> <BR> Dim hatchObj As AcadHatch<BR> Dim patternName As String<BR> Dim PatternType As Long<BR> Dim bAssociativity As Boolean<BR> <BR> ' Define the hatch<BR> patternName = "ANSI31"<BR> PatternType = 0<BR> bAssociativity = True<BR> <BR> ' Create the associative Hatch object<BR> Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)<BR> <BR> ' Create the outer loop for the hatch.<BR> ' An arc and a line are used to create a closed loop.<BR> Dim outerLoop(0 To 1) As AcadEntity<BR> Dim center(0 To 2) As Double<BR> Dim radius As Double<BR> Dim startAngle As Double<BR> Dim endAngle As Double<BR> center(0) = 5: center(1) = 3: center(2) = 0<BR> radius = 1<BR> startAngle = 0<BR> endAngle = 3.141592<BR> Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)<BR> Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).EndPoint, outerLoop(0).StartPoint)<BR> <BR> ' Append the outer loop to the hatch object, and display the hatch<BR> hatchObj.AppendOuterLoop (outerLoop)<BR> hatchObj.Evaluate<BR> ZoomAll<BR> <BR>End Sub 原因:比例太大,造成要填充的面积中不能出现填充图案,所以出错。<BR>可以修改圆弧的半径,或在Set hatchObj...后增加:<BR>hatchObj.PatternScale = 0.2
页:
[1]