[编程交流] VBA填充多段线

 
Sub Example_AddHatch()
   ' This example creates an associative gradient hatch in model space.
   
   Dim hatchObj As AcadHatch
   Dim patternName As String
   Dim PatternType As Long
   Dim bAssociativity As Boolean
   
   ' Define the hatch
   patternName = "CYLINDER"
   PatternType = acPreDefinedGradient '0
   bAssociativity = True
   
   ' Create the associative Hatch object in model space
   Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity, acGradientObject)
   Dim col1 As AcadAcCmColor, col2 As AcadAcCmColor
   Set col1 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.18")
   Set col2 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.18")
   Call col1.SetRGB(255, 0, 0)
   Call col2.SetRGB(0, 255, 0)
   hatchObj.GradientColor1 = col1
   hatchObj.GradientColor2 = col2
   
   ' Create the outer boundary for the hatch (a circle)
   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)
   
   ' Append the outerboundary to the hatch object, and display the hatch
   hatchObj.AppendOuterLoop (outerLoop)
   hatchObj.Evaluate
   ThisDrawing.Regen True
End Sub