you have to:
1) insert a new Block object
2) "Add" all graphic elements (hatches, LWPolys) to this newly created block, instead of to the drawing modelspace
3) insert a block reference of the new block in the drawing modelspace
so the changes to your code are minimal, as outlined by comments in the following:
Option Explicit
Public Sub DrawTexasFlagOp()
Dim PT1 As Variant
Dim PT2 As Variant
Dim pntLL(0 To 2) As Double
Dim pntLR(0 To 2) As Double
Dim pntUL(0 To 2) As Double
Dim pntUR(0 To 2) As Double
Dim pntLRBlue(0 To 2) As Double
Dim pntURBlue(0 To 2) As Double
Dim vertDist As Double
Dim horzDist As Double
Dim pntRW_Left(0 To 2) As Double
Dim pntRW_Right(0 To 2) As Double
Dim circleDiameter As Double
Dim cntPnt(0 To 2) As Double
Dim cir As AcadCircle
Dim starTopPoint(0 To 2) As Double
' star leg length @ unit circle of 1 = .7265
' starlegLength is variable
Dim starLegLen As Double
Dim starLegStart As Variant
Dim starLegEnd As Variant
PT1 = ThisDrawing.Utility.GetPoint(, "Pick lower left corner of Flag")
vertDist = ThisDrawing.Utility.GetDistance(PT1, vbCr & "Pick distance for vertical")
horzDist = (vertDist / 2) * 3
pntLL(0) = PT1(0) 'X value
pntLL(1) = PT1(1) 'Y value
pntUL(0) = PT1(0)
pntUL(1) = PT1(1) + vertDist
pntLR(0) = PT1(0) + horzDist
pntLR(1) = PT1(1)
pntUR(0) = PT1(0) + horzDist
pntUR(1) = PT1(1) + vertDist
pntLRBlue(0) = pntLL(0) + (horzDist / 3)
pntLRBlue(1) = pntLL(1)
pntURBlue(0) = pntLL(0) + (horzDist / 3)
pntURBlue(1) = pntLL(1) + vertDist
pntRW_Left(0) = pntLRBlue(0)
pntRW_Left(1) = pntLRBlue(1) + (vertDist / 2)
pntRW_Right(0) = pntLR(0)
pntRW_Right(1) = pntRW_Left(1)
circleDiameter = (horzDist / 3) * 0.75
cntPnt(0) = pntLL(0) + horzDist / 6
cntPnt(1) = pntLL(1) + vertDist / 2
starTopPoint(0) = cntPnt(0)
starTopPoint(1) = cntPnt(1) + (circleDiameter / 2)
starLegLen = 0.7265 * (circleDiameter / 2)
Dim plineObjStar As AcadLWPolyline
Dim pointsStar(0 To 21) As Double
starLegStart = starTopPoint
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(288), starLegLen)
pointsStar(0) = starTopPoint(0)
pointsStar(1) = starTopPoint(1)
pointsStar(2) = starLegEnd(0)
pointsStar(3) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(0), starLegLen)
pointsStar(4) = starLegEnd(0)
pointsStar(5) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(216), starLegLen)
pointsStar(6) = starLegEnd(0)
pointsStar(7) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(288), starLegLen)
pointsStar(8) = starLegEnd(0)
pointsStar(9) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(144), starLegLen)
pointsStar(10) = starLegEnd(0)
pointsStar(11) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(216), starLegLen)
pointsStar(12) = starLegEnd(0)
pointsStar(13) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(72), starLegLen)
pointsStar(14) = starLegEnd(0)
pointsStar(15) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(144), starLegLen)
pointsStar(16) = starLegEnd(0)
pointsStar(17) = starLegEnd(1)
starLegStart = starLegEnd
starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(0), starLegLen)
pointsStar(18) = starLegEnd(0)
pointsStar(19) = starLegEnd(1)
pointsStar(20) = starTopPoint(0)
pointsStar(21) = starTopPoint(1)
Dim mylayer As AcadLayer
Set mylayer = ThisDrawing.Layers.Add("RED")
mylayer.color = acRed
Set mylayer = ThisDrawing.Layers.Add("WHITE")
mylayer.color = acWhite
Set mylayer = ThisDrawing.Layers.Add("BLUE")
mylayer.color = acBlue
Set mylayer = ThisDrawing.Layers.Item("RED")
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")
Dim hatchObj As AcadHatch
Dim hatchObj2 As AcadHatch
Dim hatchObj3 As AcadHatch ' blue
Dim hatchobj4 As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
'------------------------------------------------------------
' Define the block
Dim flagBlock As AcadBlock
Set flagBlock = ThisDrawing.Blocks.Add(PT1, "FlagBlock")
'------------------------------------------------------------
With flagBlock '<--| reference the new block for all subsequent "Add" methods
' Define the hatch
patternName = "SOLID"
PatternType = 0
bAssociativity = True
Set hatchObj = .AddHatch(PatternType, patternName, bAssociativity) '<--| .AddHatch will add a hatch to the referenced block, instead of to the drawing modelspace
Dim plineObj As AcadLWPolyline
Dim points(0 To 9) As Double
points(0) = pntRW_Left(0)
points(1) = pntRW_Left(1)
points(2) = pntRW_Right(0)
points(3) = pntRW_Right(1)
points(4) = pntUR(0)
points(5) = pntUR(1)
points(6) = pntURBlue(0)
points(7) = pntURBlue(1)
points(8) = pntRW_Left(0)
points(9) = pntRW_Left(1)
Set plineObj = .AddLightWeightPolyline(points) '<--| .AddLightWeightPolyline will add a LWPoly to the referenced block, instead of to the drawing modelspace
plineObj.Closed = False
Dim outerLoop As Variant
Dim outerLoopArray(0) As Object
Set outerLoopArray(0) = plineObj
outerLoop = outerLoopArray
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Layer = "WHITE"
hatchObj.Evaluate
plineObj.Delete ' white hatch polyline
ThisDrawing.Regen True
'create red hatch pline
points(0) = pntRW_Left(0)
points(1) = pntRW_Left(1)
points(2) = pntRW_Right(0)
points(3) = pntRW_Right(1)
points(4) = pntLR(0)
points(5) = pntLR(1)
points(6) = pntLRBlue(0)
points(7) = pntLRBlue(1)
points(8) = pntRW_Left(0)
points(9) = pntRW_Left(1)
Set plineObj = .AddLightWeightPolyline(points) '<--| see above comments
plineObj.Closed = False
Set outerLoopArray(0) = plineObj
outerLoop = outerLoopArray
Set hatchObj2 = .AddHatch(PatternType, patternName, bAssociativity) '<--| see above comments
hatchObj2.AppendOuterLoop (outerLoop)
hatchObj2.Layer = "red"
hatchObj2.Evaluate
plineObj.Delete ' red hatch polyline
points(0) = pntLL(0)
points(1) = pntLL(1)
points(2) = pntUL(0)
points(3) = pntUL(1)
points(4) = pntURBlue(0)
points(5) = pntURBlue(1)
points(6) = pntLRBlue(0)
points(7) = pntLRBlue(1)
points(8) = pntLL(0)
points(9) = pntLL(1)
Set plineObj = .AddLightWeightPolyline(points) '<--| see above comments
plineObj.Closed = False
Set plineObjStar = .AddLightWeightPolyline(pointsStar) '<--| see above comments
Dim innerLoop As Variant
Dim innerLoopArray(0) As Object
Set innerLoopArray(0) = plineObjStar
innerLoop = innerLoopArray
Set outerLoopArray(0) = plineObj
outerLoop = outerLoopArray
Set hatchObj3 = .AddHatch(PatternType, patternName, bAssociativity) '<--| see above comments
hatchObj3.AppendOuterLoop (outerLoop)
hatchObj3.AppendInnerLoop (innerLoop)
hatchObj3.Layer = "blue"
hatchObj3.Evaluate
plineObj.Delete ' red hatch polyline
Set hatchobj4 = .AddHatch(PatternType, patternName, bAssociativity) '<--| see above comments
hatchobj4.AppendOuterLoop (innerLoop)
hatchobj4.Layer = "white"
hatchobj4.Evaluate
plineObjStar.Delete
End With
'------------------------------------------------------------
' Insert the block
Dim blockRefObj As AcadBlockReference
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(PT1, "FlagBlock", 1#, 1#, 1#, 0)
'------------------------------------------------------------
ThisDrawing.Regen True
ZoomAll
End Sub
Private Function rtod(r As Double)
rtod = (r * 180) / 3.14159265358979
End Function
Private Function dtor(d As Double)
dtor = (d * 3.14159265358979) / 180
End Function