Inserting Block & Adding Fields to Attributes

Anonymous · ‎07-07-2016

The block is simple with 3 attributes, no fields, no preset, no prompts. Goal - Insert block, pull area fields from existing closed polylines, insert fields in attributes of blocks.

Right now it shows a partial of the field formula in the block when inserted. Need it to show the value of the field.

Imports System.IO
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Public Class BaseArea

    Property AcDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
    Property AcDb As Database = AcDoc.Database
    Property AcEd As Editor = AcDoc.Editor
    Property Origlayer As String = Core.Application.GetSystemVariable("clayer")
    Property Origosmode = Core.Application.GetSystemVariable("osmode")
    Property Origorthomode = Core.Application.GetSystemVariable("orthomode")
    Property OrigSnapAngle = Core.Application.GetSystemVariable("snapang")
    Property OrigDimScale = Core.Application.GetSystemVariable("dimscale")
    Property OrigDimStyle = Core.Application.GetSystemVariable("DIMSTYLE")
    Property LayList As New List(Of String)
    Property GStr As String
    Property AStr As String
    Property NStr As String
    Property BlkTab As BlockTable
    Property BlkTabRec As BlockTableRecord
    Property BlkRef As BlockReference
    Property BlkRefId As ObjectId
    Property Fstr As String


    <CommandMethod("xxx")>
    Public Sub areafields()
        LayList.Add("AREA")
        LayList.Add("AREA-AC")
        LayList.Add("AREA-NonAC")
        For Each item In LayList
            Dim ents As ObjectIdCollection = GetEntitiesOnLayer(item.ToString)

            Using AcTrans As Transaction = AcDb.TransactionManager.StartTransaction
                Dim AcBlkTab As BlockTable = AcTrans.GetObject(AcDb.BlockTableId, OpenMode.ForRead)
                For Each entid As ObjectId In ents
                    Dim pl As Polyline = DirectCast(AcTrans.GetObject(entid, OpenMode.ForRead), Polyline)
                    If pl.Layer = "AREA" Then
                        GStr = String.Format("%<\AcObjProp Object(%<\_ObjId  " & pl.ObjectId.ToString & " \f ""%lu2%ct4%qf1 SQ. FT."">%", GStr)
                    ElseIf pl.Layer = "AREA-AC" Then
                        AStr = String.Format("%<\AcObjProp Object(%<\_ObjId  " & pl.ObjectId.ToString & " \f ""%lu2%ct4%qf1 SQ. FT."">%", AStr)
                    ElseIf pl.Layer = "AREA-nonAC" Then
                        NStr = String.Format("%<\AcObjProp Object(%<\_ObjId  " & pl.ObjectId.ToString & " \f ""%lu2%ct4%qf1 SQ. FT."">%", NStr)
                    End If
                Next
            End Using
        Next
        addblock()
    End Sub

    Public Sub addblock()
        Using (AcDoc.LockDocument())
            Using OpenDb As New Database(False, True)
                OpenDb.ReadDwgFile("\\ba-server\cad config\Forum\Library-Block\0000-Symbols\AREA BLOCK-X.dwg", FileShare.ReadWrite, True, "")
                Dim ids As New ObjectIdCollection()
                Using tr As Transaction = OpenDb.TransactionManager.StartTransaction()
                    Dim bt As BlockTable
                    bt = DirectCast(tr.GetObject(OpenDb.BlockTableId, OpenMode.ForRead), BlockTable)
                    If bt.Has("AREA BLOCK") Then
                        ids.Add(bt("AREA BLOCK"))
                    End If
                    tr.Commit()
                End Using
                If ids.Count <> 0 Then
                    Dim destdb As Database = AcDoc.Database
                    Dim iMap As New IdMapping()
                    destdb.WblockCloneObjects(ids, destdb.BlockTableId, iMap, DuplicateRecordCloning.Ignore, False)
                End If
            End Using
        End Using
        Core.Application.DocumentManager.MdiActiveDocument = AcDoc
        InsertBlock()
    End Sub

    Private Sub InsertBlock()
        Using (AcDoc.LockDocument())
            Using AcTrans As Transaction = AcDb.TransactionManager.StartTransaction()
                Dim BlkTab As BlockTable = DirectCast(AcTrans.GetObject(AcDb.BlockTableId, OpenMode.ForRead), BlockTable)
                If BlkTab.Has("AREA BLOCK") Then
                    Dim BlkTabRec As BlockTableRecord = DirectCast(AcTrans.GetObject(BlkTab("AREA BLOCK"), OpenMode.ForRead), BlockTableRecord)
                    Using BlkRef As New BlockReference(Point3d.Origin, BlkTab("AREA BLOCK"))
                        BlkRef.TransformBy(AcEd.CurrentUserCoordinateSystem)
                        Dim curspace As BlockTableRecord = DirectCast(AcTrans.GetObject(AcDb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                        curspace.AppendEntity(BlkRef)
                        AcTrans.AddNewlyCreatedDBObject(BlkRef, True)
                        If BlkTabRec.HasAttributeDefinitions Then
                            Dim attInfos As New Dictionary(Of String, TextInfo)()
                            Dim attribClass As RXClass = RXObject.GetClass(GetType(AttributeDefinition))
                            For Each id As ObjectId In BlkTabRec
                                Dim obj As DBObject = id.GetObject(OpenMode.ForRead)
                                Dim attdef As AttributeDefinition = TryCast(obj, AttributeDefinition)
                                If (attdef IsNot Nothing) AndAlso (Not attdef.Constant) Then
                                    Using attref As New AttributeReference
                                        BlkRef.AttributeCollection.AppendAttribute(attref)
                                        attref.SetAttributeFromBlock(attdef, BlkRef.BlockTransform)
                                        AcTrans.AddNewlyCreatedDBObject(attref, True)
                                        Dim fldstr As String
                                        If attref.Tag = "AREA-GROSS" Then
                                            fldstr = GStr
                                        ElseIf attref.Tag = "AREA-AC" Then
                                            fldstr = AStr
                                        ElseIf attref.Tag = "AREA-NONAC" Then
                                            fldstr = NStr
                                        End If
                                        Dim fld As Field = New Field(fldstr)
                                        fld.SetFieldCode(fldstr)
                                        fld.Evaluate()
                                        attref.SetField(fld)
                                        AcTrans.AddNewlyCreatedDBObject(fld, True)

                                    End Using
                                End If
                            Next
                        End If
                    End Using
                Else
                    Core.Application.ShowAlertDialog(String.Format("Block '{0}' not found.", "AREA BLOCK"))
                End If
                AcTrans.Commit()
            End Using
            Pieces.Reset(Origlayer, Origosmode, Origorthomode, OrigSnapAngle, OrigDimScale)
        End Using
    End Sub

    Private Function GetEntitiesOnLayer(layerName As String) As ObjectIdCollection

        ' Build a filter list so that only entities on the specified layer are selected
        Dim tvs As TypedValue() = New TypedValue(1) {}
        tvs(0) = New TypedValue(CInt(DxfCode.LayerName), layerName)
        tvs(1) = New TypedValue(DxfCode.Start, "LWPOLYLINE")
        Dim sf As New SelectionFilter(tvs)
        Dim psr As PromptSelectionResult = AcEd.SelectAll(sf)
        If psr.Status = PromptStatus.OK Then
            Return New ObjectIdCollection(psr.Value.GetObjectIds())
        Else
            Return New ObjectIdCollection()
        End If
    End Function

End Class

deepak.a.s.nadig · ‎07-15-2016

I have written a quick sample code to insert a 'test' block (circle with center point as an attribute ) and add a field to it.

Attached is a drawing to test the sample. Here is the sample code :

 Public Sub addcircleattribute()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim AcDb As Database = doc.Database

            Using AcTrans As Transaction = AcDb.TransactionManager.StartTransaction
                Dim BlkTab As BlockTable = AcTrans.GetObject(AcDb.BlockTableId, OpenMode.ForRead)
                If BlkTab.Has("test") Then
                    Dim BlkTabRec As BlockTableRecord = DirectCast(AcTrans.GetObject(BlkTab("test"), OpenMode.ForWrite), BlockTableRecord)
                    Using BlkRef As New BlockReference(Point3d.Origin, BlkTabRec.ObjectId)
                        Dim curspace As BlockTableRecord = DirectCast(AcTrans.GetObject(AcDb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                        curspace.AppendEntity(BlkRef)
                        AcTrans.AddNewlyCreatedDBObject(BlkRef, True)
                        If BlkTabRec.HasAttributeDefinitions Then
                            For Each id As ObjectId In BlkTabRec
                                Dim obj As DBObject = id.GetObject(OpenMode.ForRead)
                                Dim cp As Point3d
                                Dim circ As Circle
                                Dim objID As ObjectId
                                If TypeOf (obj) Is Circle Then
                                    circ = CType(obj, Circle)
                                    cp = circ.Center
                                    objID = circ.ObjectId
                                End If
                                If TypeOf obj Is AttributeDefinition Then
                                    Dim acAtt As AttributeDefinition = obj
                                    Using acAttRef As New AttributeReference
                                        acAttRef.SetAttributeFromBlock(acAtt, BlkRef.BlockTransform)
                                        acAttRef.Position = acAtt.Position.TransformBy(BlkRef.BlockTransform)

                                        Dim str1 As String = "%<\AcObjProp.16.2 Object(%<\_ObjId "
                                        Dim strID = objID.OldIdPtr.ToString()
                                        Dim str2 As String = ">%,1).Center \f ""%lu2"">%"

                                        Dim str As String = str1 + strID + str2
                                        Dim fldstr As String = String.Format(str, cp.ToString())
                                        acAttRef.TextString = acAtt.TextString
                                        BlkRef.AttributeCollection.AppendAttribute(acAttRef)

                                        Dim field As Field = New Field(fldstr)
                                        field.Evaluate()
                                        Dim fieldEval As FieldEvaluationStatusResult = field.EvaluationStatus
                                        If fieldEval.Status <> FieldEvaluationStatus.Success Then
                                            AcTrans.Abort()
                                            ed.WriteMessage(vbCrLf & String.Format("FieldEvaluationStatus Message: {0} - {1}", fieldEval.Status, fieldEval.ErrorMessage))
                                            Exit Sub
                                        Else
                                            Try
                                                acAttRef.SetField(field)
                                                AcTrans.AddNewlyCreatedDBObject(field, True)
                                                ed.WriteMessage(vbCrLf & String.Format("Block '{2}' -> Attribute '{0}' -> field set to: {1}", acAttRef.Tag, field.Value, BlkRef.Name))
                                            Catch
                                                field.Dispose()
                                                ed.WriteMessage(vbCrLf & String.Format("Failed to set attribute field '{0}' - {1}", acAttRef.Tag, acAttRef.Handle))
                                            End Try
                                        End If
                                        AcTrans.AddNewlyCreatedDBObject(acAttRef, True)
                                    End Using
                                End If
                            Next
                        End If
                    End Using
                End If
                AcTrans.Commit()
            End Using
        End Sub

Anonymous · ‎07-15-2016

Not quite the concept of what I was going for. My block would have attributes without a field to start. On insertion into the drawing the fields would be pulled from polylines on specific layers and the fields would then need to be put in the attributes of the block. On saying this I realize that I might need to look closer at your example to see if I can make it work for me. I'll get back to this weekend.

Anonymous · ‎07-15-2016

My error was not in removing the '(' & ')' from the object id string before putting it in the field. All good now.

Community

Inserting Block &amp; Adding Fields to Attributes