[编程交流] 孵出

' borrowed from the Help file
Public Function DrawHatch(intPt As Variant, hatLayer As String, patName As String, patType As Long, blnAssoc As Boolean, _
hatScale As Double, hatAngle As Double, hatCol As Integer) As AcadHatch
' This example creates an associative hatch in model space.
Dim hatchObj As AcadHatch
On Error GoTo Err_Control
' Create the associative Hatch object in model space
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patType, patName, blnAssoc)
' add properties
hatchObj.Layer = hatLayer
hatchObj.AssociativeHatch = blnAssoc
hatchObj.PatternScale = hatScale
hatchObj.PatternAngle = hatAngle
hatchObj.color = hatCol
' Create the outer boundary for the hatch
Dim ObjLast As AcadEntity
Dim i As Integer
'Dim intPt As Variant
Dim pstr As String
Dim outerLoop(0) As AcadEntity
i = ThisDrawing.ModelSpace.Count - 1
'intPt = ThisDrawing.Utility.GetPoint(, "Pick the inner point of boundary")
pstr = Replace(CStr(intPt(0)), ",", ".") & "," & Replace(CStr(intPt(1)), ",", ".")
ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & pstr & vbCr & vbCr
Set ObjLast = ThisDrawing.ModelSpace.Item(i + 1)
Set outerLoop(0) = ObjLast
' Append the outerboundary to the hatch object, and display the hatch
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
' delete boundary
ObjLast.Delete
ThisDrawing.Regen True
Set DrawHatch = hatchObj
Err_Control:
End Function