求助（有关填充、引线）
<p>各位高手</p><p> 本人是初学者，请教2个问题</p><p>1.填充</p><p>我使用CIRCLE1=thisdrawing.modlespase.addcircle(YX,0.5)画了个圆，怎样把它填充为绿色，并删除圆边界。</p><p>2.引线标注<br/> </p><p>如何在坐标YX处增加一个引线标注，引线及标注文字均为蓝色。</p><p> 望不吝赐教，谢谢！<br/></p> 本帖最后由 作者 于 2006-12-29 16:13:07 编辑有关填充参考
Sub Example_AddHatch()
' 该示例在模型空间中创建关联的渐变填充图案。
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
' 定义填充图案
patternName = "CYLINDER"
PatternType = acPreDefinedGradient '0
bAssociativity = True
' 在模型空间中创建关联的 Hatch 对象
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity, acGradientObject)
Dim col1 As AcadAcCmColor, col2 As AcadAcCmColor
Set col1 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Set col2 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call col1.SetRGB(255, 0, 0)
Call col2.SetRGB(0, 255, 0)
hatchObj.GradientColor1 = col1
hatchObj.GradientColor2 = col2
' 为填充图案创建外边界(圆)
Dim outerLoop(0 To 0) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 3: center(1) = 3: center(2) = 0
radius = 1
Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
' 附着外边界到填充图案对象，并显示该填充图案
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
ThisDrawing.Regen True
End Sub
Sub Example_AddLeader()
' 该示例在模型空间中创建引线。
' 在本例中引线并没有附加任何注释对象。
Dim leaderObj As AcadLeader
Dim points(0 To 8) As Double
Dim leaderType As Integer
Dim annotationObject As AcadObject
points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 4: points(4) = 4: points(5) = 0
points(6) = 4: points(7) = 5: points(8) = 0
leaderType = acLineWithArrow
Set annotationObject = Nothing
' 在模型空间中创建引线对象
Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
leaderObj .color=vbblueZoomAll
End Sub
页:
[1]