Checking if Hatch is empty?

[Anonymous]

Hi, 

I am working on a code which checks if a prescribed polyline is empty and if it is empty then enter a block.

The insertion is working but the code is inserting the block even if the block already exists. how do i fix this?

Dim aBlock As AcadBlock
Dim aBlockRef As AutoCAD.AcadBlockReference
Dim aent As AutoCAD.AcadEntity
Dim elem As Object
Dim arr As Variant
Dim BBminPoint(0 To 2) As Double
Dim BBmaxPoint(0 To 2) As Double
Dim Ipoint(0 To 2) As Double
Dim IPointArea(0 To 2) As Double
Dim IPointDesig(0 To 2) As Double
Dim strIPoint As String
Dim strBBMin As String
Dim strBBMax As String
Dim Floor_No As String
Dim insertionPoint(2) As Double
Dim minExt As Double, maxExt As Double
Dim folderPath As String
Dim plPointLL, plPointUR As Variant
Dim pWidth, pHeight As Double
Dim bWidth, bHeight As Double
Dim scaleFactor As Double
Dim fPath As String
Dim fileName As String
'Dim objBlockRef As AcadBlockReference
Dim scale1(2) As Integer
Dim XLL(2), YLL(2), XUR(2), YUR(2) As Double
Dim blockName As String
Public Sub AddSpaceBlock()

Dim acUtil As AcadUtility
Dim acVport As AcadViewport
Dim acSS As AcadSelectionSet
Dim acVp As AcadObject
Dim sLayout As String
Dim iCode() As Integer
Dim vValue() As Variant
Dim vPt As Variant
Dim vPtMs As Variant
Dim dHt As Double
Dim dWd As Double
Dim dScl As Double
Dim dUR(2) As Double
Dim dLL(2) As Double
Dim vBlnInfo As Variant
Dim blk As AcadBlockReference
Dim elem As AcadEntity
Dim blkLL As Variant
Dim blkUR As Variant
Dim objBlockRef As AcadEntity
Set acUtil = ThisDrawing.Utility
'Dim pli As AcadPolyline
Dim blnBlkFound As Boolean
Dim intersectP() As Double
Dim bblk As AcadBlock
Dim count As Integer
Dim textString As String
Dim rsSpace As ADODB.Recordset

Dim pline As AcadLWPolyline
Dim SSet As AcadSelectionSet
Dim filttype(1) As Integer
ReDim filtdata(1) As Variant
Dim dxfCode, dxfValue
Dim nestEnt(0) As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim hatchobj As AcadHatch

filttype(0) = 0
filttype(1) = 2
filtdata(0) = "INSERT"
filtdata(1) = "Etichetta Locale"
dxfCode = filttype: dxfValue = filtdata

 
    fPath = "C:\Users\VEANKA LT002\Documents\ACAD\Blocks\"
    fileName = fPath + "Space_Info.dwg"
    
    dblX = 1
    dblY = 1
    dblZ = 1
    dblRotation = 0
    
    Set rsSpace = New ADODB.Recordset
    rsSpace.CursorLocation = adUseClient
    rsSpace.Fields.Append "ObjectID", adBigInt
    rsSpace.Open
 
 
    Dim rsNIA As ADODB.Recordset
    Set rsNIA = New ADODB.Recordset
    rsNIA.CursorLocation = adUseClient
    rsNIA.Fields.Append "LAYER", adVarChar, 50
    rsNIA.Fields.Append "BLOCK", adVarChar, 30
    rsNIA.Fields.Append "FLOOR", adVarChar, 30
    rsNIA.Fields.Append "AREA", adDouble
    rsNIA.Fields.Append "XLL", adDouble
    rsNIA.Fields.Append "XUR", adDouble
    rsNIA.Fields.Append "YLL", adDouble
    rsNIA.Fields.Append "YUR", adDouble
    rsNIA.Fields.Append "check", adChar, 1
    rsNIA.Open
        
    'GET blocks with ObjectIDs
    For Each elem In ThisDrawing.ModelSpace
        If elem.EntityName = "AcDbBlockReference" Then
            Set blk = elem
            If UCase(blk.Name) = "SPACE_INFO" Then
                rsSpace.AddNew
                    rsSpace.Fields(0).Value = blk.ObjectID
                rsSpace.Update
            End If
        End If
    Next
    rsSpace.MoveFirst
    'now check if the blocks exist in the policy
    For Each elem In ThisDrawing.ModelSpace
        If elem.EntityName = "AcDbPolyline" Then
            elemLayer = elem.Layer
            Set pline = elem
            
            If InStr(1, elemLayer, "F07200") > 0 Then
                blockName = Right(elemLayer, 2)
                If Left(blockName, 1) = "0" Then
                    blockName = Right(blockName, 1)
                End If
                
              If Not IsNumeric(Mid(elemLayer, 7, 1)) Then 'And (elem.LinetypeScale = 3 Or elem.LinetypeScale = 2) Then   ' This is NIA layer
                    

                    PatternName = "ANSI31"
                    PatternType = 0
                    bAssociativity = True
                    blnBlkFound = False
                    ' Create the associative Hatch object
                    Set nestEnt(0) = pline
                    Set hatchobj = ThisDrawing.ModelSpace.AddHatch(PatternType, PatternName, bAssociativity)
                    hatchobj.AppendInnerLoop (nestEnt)
'                    hatchobj.Evaluate
                 hatchobj.IntersectWith blk, acExtendNone
                    rsSpace.MoveFirst
                    Do While Not rsSpace.EOF
                        Set blk = ThisDrawing.ObjectIdToObject(rsSpace.Fields(0).Value)
                        intersectP = pline.IntersectWith(blk, acExtendNone)
                        
                        If UBound(intersectP) > -1 Then
                            blnBlkFound = True
                            Exit Do
                        Else
                            blnBlkFound = False
                        End If
                        rsSpace.MoveNext
                    Loop
                   
                    hatchobj.Delete
                    If blnBlkFound = False Then
                    ThisDrawing.Regen acActiveViewport
                      
                    
                        rsNIA.AddNew
                        rsNIA.Fields("LAYER").Value = elemLayer
                        rsNIA.Fields("BLOCK").Value = blockName
                        rsNIA.Fields("FLOOR").Value = Mid(elemLayer, 7, 2)
                        G_Area = Round((pline.Area / 1000000), 4)
                        rsNIA.Fields("AREA").Value = G_Area
                        elem.GetBoundingBox plPointLL, plPointUR
                        rsNIA.Fields("XLL").Value = plPointLL(0)
                        rsNIA.Fields("YLL").Value = plPointLL(1)
                        rsNIA.Fields("XUR").Value = plPointUR(0)
                        rsNIA.Fields("YUR").Value = plPointUR(1)
                        rsNIA.Update
                    
                        'now create and insert a new block
                        bWidth = 30
                        bHeight = 5
                        pWidth = rsNIA.Fields("XUR").Value - rsNIA.Fields("XLL").Value
                        pHeight = rsNIA.Fields("YUR").Value - rsNIA.Fields("YLL").Value
                        
                        If pWidth < pHeight Then
                            scale1(0) = (pWidth * 0.25 / bWidth) '* 100
                            scale1(1) = scale1(0)
                            scale1(2) = scale1(0)
                        Else
                            'scenario 2
                            scale1(1) = (pHeight * 0.25 / bHeight) '* 100
                            scale1(0) = scale1(1)
                            scale1(2) = scale1(1)
                        End If
                    
                    
                        insertionPoint(0) = rsNIA.Fields("XLL").Value + (pWidth / 2) '- ((bWidth * scale1(0)) / 8)
                        insertionPoint(1) = rsNIA.Fields("YLL").Value + (pHeight / 2) '- ((bHeight * scale1(1)) / 8)
                        insertionPoint(2) = 0
                                  
                        Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, fileName, scale1(0), scale1(1), scale1(2), 0)
                        ThisDrawing.Regen acAllViewports
                    End If
              End If
            End If
        End If
    Next
End Sub

What changes need to be done to make this code work?