Topic: Add hatched area to block.

[sgrya1]

Can someone please explain where I'm going wrong.
I can create a circular hatched area in model space but I want to now do the same drawing directly to a block.

One odd thing is that to do this, for some reason circleObj needs to be an array circleObj(0 To 0) As AcadEntity otherwise it doesn't append the hatch.

This is the code I've written so far to write to a block: I get a compile error saying can't assign to array at the location i've shown. Is there a fix for this. Why does it need to be an array?

Code: [Select]

Sub MakeBlock()
Dim blockObj As AcadBlock
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    With AcadDoc
        ' Define the block
        Set blockObj = .Blocks.Add(insertionPnt, "CircleBlock")
        ' Define the hatch
        PatternType = 0
        bAssociativity = True
        HatchPattern = "SOLID"
        ' Create the associative Hatch object in model space
        Set hatchObj = blockObj.AddHatch(PatternType, HatchPattern, bAssociativity)
        hatchObj.PatternScale = 1
        ' Create the outer boundary for the hatch. (a circle)
        Set circleObj = blockObj.AddCircle(Center, radius)   '<=============I get the error on this line
        ' Append the outerboundary to the hatch object, and display the hatch
        hatchObj.AppendOuterLoop (circleObj)
        hatchObj.Evaluate
        'Add Point
        Dim pointObj As AcadPoint
        Set pointObj = blockObj.AddPoint(insertionPnt)
    End With
End Sub
jonesy: added code tags

[Arizona]

Where or what are you defining circleObj as?

[Glenn R]

What's the variable 'Center' defined as...?

[Kerry]

What's the variable 'Center' defined as...?

Ditto 'radius'

[Arizona]

Just to clarify, a block is non-graphical, whereas a block reference is what you actually see in the drawing.

So to define and insert a block reference would be something like this (Sorry it's been a long day :

Code: [Select]

Dim NewBlkName As String
Dim InsertPt(0 To 2) As Double
Dim xScale As Double
Dim yScale As Double
Dim zScale As Double
Dim Rot As Double
Dim objNewBlk As AcadBlockReference

InsertPt(0) = something     'x coord
InsertPt(1) = something     'y coord
InsertPt(2) = something     'z coord

xscale = some value
yscale = some value
zscale = some value
Rot = some angle

NewBlkName = "Some name and path to a drawing"

Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot)


HTH

[Bryco]

it's a 2 step process.
1) dim oCircle as acadcircle then add tp block
2) dim varLoop(0) as acadentity
set varLoop(0)=ocircle

[Fatty]

Give this a try instead, I used CopyObjects method,
that Bryco showed in the prior thread somewhere
on this forum, take a search it
Hth

~'J'~

Code: [Select]

Sub MakeBlock()
Dim blockObj As AcadBlock
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim Radius As Double
Radius = 1#

Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    ' Define the block
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
   
    With ThisDrawing.ModelSpace

        ' Define the hatch
        PatternType = 0
        bAssociativity = True
        HatchPattern = "SOLID"
        ' Create the associative Hatch object in model space
        Set hatchobj = .AddHatch(PatternType, HatchPattern, bAssociativity)
        hatchobj.PatternScale = 1
        Dim outerLoop(0) As AcadEntity

        ' Create the outer boundary for the hatch. (a circle)
        Set outerLoop(0) = .AddCircle(insertionPnt, Radius)
        ' Append the outerboundary to the hatch object, and display the hatch
        hatchobj.AppendOuterLoop (outerLoop)
        hatchobj.Evaluate
        'Add Point
        Dim pointObj As AcadPoint
        Set pointObj = .AddPoint(insertionPnt)
       
        End With
       
    ' The array of primary objects to be copied
    Dim objCollection(0 To 1) As Object
    Dim idPairs 'optional
    ' fill array
    Set objCollection(0) = hatchobj
    Set objCollection(1) = pointObj
    ' etc, etc
    ' copy objects to block
    ThisDrawing.CopyObjects objCollection, blockObj, idPairs
   
End Sub