Add area from hatch to block

[Anonymous]

I have some drawings with hatches on several layers. I need to extract the area, layer and room number.

Right now I have a block with two attributes. One prompts for the room number and the other is an object field. 

I'm wondering if there is a way to make the block prompt the user to select the hatch pattern when inserted then fill in the field with the area?  Its very tedious to go through and edit the block then edit the attribute then edit the field and select the hatch for hundreds of rooms. 

The end goal is to extract the data from the blocks from several drawings so we know how much of each area type we have and where it is located. 

[norman.yuan]

Linking block attribute to other entity (Hatch, in your case) with field is just as simple as set the attribute's TextString to a valid field code. 

For example, you can use command "Field" to find out what the field code for a Hatch's Area property is look like. In this case, if the drawing uses imperial unit, the code would look like:

%<\AcObjProp.16.2 Object(%<\_ObjId 1149432352>%).Area \f "%lu2%ps[, SQ. FT.]%ct8[0.0069444444444444]">%

As you can see, to link this field code to any Hatch object in drawing, you only need to find out the target hatch's object ID and replace it in above code. Then you simply assign this field code to AcadAttributeReference's TextString.

Following code assume that a block with name "RoomArea" has inserted into the drawing, which as a attribute with tag "Area"; and user is asked to first select a block, and then select a hatch to linked to.

Option Explicit

Public Sub SetUpField()

    Dim ent As AcadEntity
    Dim blk As AcadBlockReference
    Dim i As Integer
    Dim atts As Variant
    Dim att As AcadAttributeReference
    Dim hatchId As LongPtr
    
    Dim hatchAreaFieldString As String
    hatchAreaFieldString = "%<\AcObjProp.16.2 Object(%<\_ObjId [IDNUMBER]>%).Area \f ""%lu2%ps[, SQ. FT.]%ct8[0.0069444444444444]"">%"
    
    Set ent = SelectEntity("Select RoomArea block:")
    If ent Is Nothing Then Exit Sub
    
    On Error GoTo 0
    
    If TypeOf ent Is AcadBlockReference Then
    
        Set blk = ent
        If UCase(blk.EffectiveName) = "ROOMAREA" Then
        
            Set ent = SelectEntity("Select room hatch:")
            If ent Is Nothing Then Exit Sub
            If TypeOf ent Is AcadHatch Then
                
                hatchId = ent.ObjectID
                
                atts = blk.GetAttributes()
                For i = 0 To UBound(atts)
                    Set att = atts(i)
                    If UCase(att.TagString) = "AREA" Then
                        att.TextString = Replace(hatchAreaFieldString, "[IDNUMBER]", CStr(hatchId))
                        att.Update
                        Exit For
                    End If
                Next
            End If
        End If
    End If
    
End Sub

Private Function SelectEntity(msg As String) As AcadEntity

    Dim ent As AcadEntity
    Dim pt As Variant
    On Error Resume Next
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & msg
    Set SelectEntity = ent

End Function

While this code is used to link a existing block to room hatch, you can certainly write your own code to insert the block and create the link at the time when block is inserted.

HTH

[Anonymous]

How do i use the code? Its not a LISP or script correct? Do i just need to define a variable and end the function?

[norman.yuan]

Well, you posted in VBA discussion forum, thus I assume you at least know how VBA code runs (creating VBA code in a VBA project *.dvb file; loading *.DVB file, run VBA macro...), and are able to understand very basic VBA code.

Of course it can also be done with LISP, if that is what you can grasp. But you may want to post question to Lisp forum

[Anonymous]

Sorry about that. I must have clicked on the wrong forum...