Extract Attribut Info from a Block in a Xref

Extract Attribut Info from a Block in a Xref

Anonymous
Not applicable
639 Views
2 Replies
Message 1 of 3

Extract Attribut Info from a Block in a Xref

Anonymous
Not applicable

Here a exemple issu from my below sub :

Example.png

 

here the sub :

<CommandMethod("test")> _
    Public Shared Sub Test()

        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        While (True)
            Using tr As Transaction = acCurDb.TransactionManager.StartTransaction()
                Dim acBlkTbl As BlockTable
                acBlkTbl = tr.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
                Dim acBlkTblRec As BlockTableRecord
                acBlkTblRec = tr.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                Application.SetSystemVariable("OSMODE", 512)
                Dim prent As PromptEntityOptions = New PromptEntityOptions(vbCrLf & "Specify Entity:")
                prent.SetRejectMessage("Only BlockReferences Allowed!")
                prent.AddAllowedClass(GetType(BlockReference), True)
                Dim rsent As PromptEntityResult = acDoc.Editor.GetEntity(prent)
                If Not rsent.Status = PromptStatus.OK Then Return
                Dim pneo As PromptNestedEntityOptions
                pneo = New PromptNestedEntityOptions("")
                pneo.NonInteractivePickPoint = rsent.PickedPoint
                pneo.UseNonInteractivePickPoint = True
                pneo.AllowNone = True

                If Not acDoc.Editor.GetNestedEntity(pneo).ObjectId = ObjectId.Null Or IsNothing(acDoc.Editor.GetNestedEntity(pneo).ObjectId) Or IsDBNull(acDoc.Editor.GetNestedEntity(pneo).ObjectId) Then

                    Dim psubent As Entity = tr.GetObject(acDoc.Editor.GetNestedEntity(pneo).ObjectId, OpenMode.ForRead)

                    Dim obj As DBObject = tr.GetObject(psubent.ObjectId, OpenMode.ForRead)
                    'si choix d'une entité autre que AttributReference --> TableBlockRecord
                    '  sinon Blockreference.
                    Do While Not (TypeOf (obj) Is BlockTableRecord) And Not (TypeOf (obj) Is BlockReference)
                        acDoc.Editor.WriteMessage(vbCrLf & "TypeName : " & TypeName(obj) & " GetRXClass" & obj.GetRXClass.Name.ToString)
                        obj = tr.GetObject(obj.OwnerId, OpenMode.ForRead)
                    Loop
                    acDoc.Editor.WriteMessage(vbCrLf & "FIN       -    TypeName : " & TypeName(obj) & " GetRXClass" & obj.GetRXClass.Name.ToString)

                    Dim Nom As String = ""
                    Select Case True
                        Case TypeOf (obj) Is BlockTableRecord
                            Nom = CType(obj, BlockTableRecord).Name
                        Case TypeOf (obj) Is BlockReference
                            With CType(obj, BlockReference)
                                Dim objBlocDef As BlockTableRecord = tr.GetObject(.DynamicBlockTableRecord, OpenMode.ForRead)
                                Nom = objBlocDef.Name
                                acDoc.Editor.WriteMessage(vbCrLf & "Nom " & Nom)
                            End With
                    End Select

                    If Nom.Contains("|") Then
                        Dim dec As String() = Split(Nom, "|")
                        acDoc.Editor.WriteMessage(vbCrLf & "Nom du bloc: " & dec(UBound(dec)))
                    Else
                        acDoc.Editor.WriteMessage(vbCrLf & "ce n'est pas un bloc")
                    End If

                Else
                    'AcDbBlockReference
                End If

                pneo = Nothing
            End Using
        End While

    End Sub

when i select a block i have BlockTableRecord and when selec a attribut i have BlockReference.

How i can retrieve info from all bloc.. Each Bloc have a attribut not visible. Wht i dont have BlockReference when select a block with attribut not visible ?

Can you improve my sub ?

 

thanks all.

0 Likes
Accepted solutions (1)
640 Views
2 Replies
Replies (2)
Message 2 of 3

_gile
Consultant
Consultant
Accepted solution

Hi,

 

You can use GetNestedEntity () and test the type of the owner object transparently for the user.
If the user selects an attribute, the block will be the owner of the attribute.
If the user selects another entity type, the block will be the first container of the entity.

 

On peut utiliser GetNestedEntity() et tester le type de l'objet propriétaire de manière transparente pour l'utilisateur.
Si l'utilisateur sélectionne un attribut, le bloc sera le propriétaire de l'attribut.
Si l'utilisateur sélectionne un autre type d'entité, le bloc sera le premier conteneur de l'entité.

 

        [CommandMethod("Test")]
        public void Test()
        {
            var doc = Application.DocumentManager.MdiActiveDocument;
            var db = doc.Database;
            var ed = doc.Editor;

            using (var tr = db.TransactionManager.StartTransaction())
            {
                while (true)
                {
                    var result = ed.GetNestedEntity("\nSélectionnez un bloc: ");
                    if (result.Status == PromptStatus.Cancel)
                        return;
                    var entity = (Entity)tr.GetObject(result.ObjectId, OpenMode.ForRead);
                    if (entity is AttributeReference)
                    {
                        var blkRef = (BlockReference)tr.GetObject(entity.OwnerId, OpenMode.ForRead);
                        ed.WriteMessage($"\nNom du bloc : {blkRef.Name}");
                        break;
                    }
                    var containers = result.GetContainers();
                    if (containers.Length > 0)
                    {
                        var blkRef = (BlockReference)tr.GetObject(containers[0], OpenMode.ForRead);
                        ed.WriteMessage($"\nNom du bloc : {blkRef.Name}");
                        break;
                    }
                    ed.WriteMessage("\nL'objet sélectionné n'est pas un bloc.");
                }
                tr.Commit();
            }
        }


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes
Message 3 of 3

Anonymous
Not applicable

Thanks, more easy your solution.

 

here my code in vb. :

 

 Public Shared Sub Test()
        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        Dim ed = doc.Editor
        Dim tr As Transaction = db.TransactionManager.StartTransaction()
        Dim blkRef As BlockReference = Nothing

        Using (tr)

            Do While (True)

                Dim result = ed.GetNestedEntity("Sélectionnez un bloc: ")
                If (result.Status = PromptStatus.Cancel) Then Return

                Dim entity = tr.GetObject(result.ObjectId, OpenMode.ForRead)
                If TypeOf (entity) Is AttributeReference Then
                    blkRef = tr.GetObject(entity.OwnerId, OpenMode.ForRead)
                    ed.WriteMessage(vbCrLf & "Nom du bloc : " & blkRef.Name)
                    Exit Do
                End If
                Dim containers = result.GetContainers()
                If (containers.Length > 0) Then
                    blkRef = tr.GetObject(containers(0), OpenMode.ForRead)
                    ed.WriteMessage(vbCrLf & "Nom du bloc : " & blkRef.Name)
                    Exit Do
                End If
                ed.WriteMessage(vbCrLf & "L'objet sélectionné n'est pas un bloc.")
            Loop

            tr.Commit()
        End Using

        If IsNothing(blkRef) = False Then
              'Here sub for  show attribut.
              extractAttBloc(True, blkRef, False)
        End If
    End Sub

And here my Sub for generate a collection with all attribut

  '**********************************************************************************
    'Function d'extraction des attributs depuis une référence de blocs
    ' Entrée : 
    '   Debug       : si True affichage des messages
    '   BlocRef : La référence du bloc
    '   OkUnique : si true  alors sortie de la collection avec une key unqiue
    '              si false alors sortie de la collection sans clé
    '
    ' Sortie 
    '   CollBlocRef : la collection pour la récupération (déjà init)
    '     Format : collection d'élement de tableau à 2 dimensions si OkUnique=False
    '              Collection de Key/Data si OkUnique=True
    '     = Nothing si Erreur ou rien d'extrait  
    '   

    '**********************************************************************************
    Public Enum Enum_GB_ExtAtt As Byte
        Key = 0
        Contenue = 1
        Objet = 2
    End Enum

    Public Function ExtractAttBloc(ByVal debug As Boolean, ByRef BlocRef As BlockReference, ByVal OkUnique As Boolean) As Collection

        Dim DataRet As New Collection
        Dim OkErreur As Boolean = False
        Dim FormatData() As Object

        Dim doc As Document = acApp.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim tr As Transaction = db.TransactionManager.StartTransaction()
        Try
            For Each myAttId As ObjectId In BlocRef.AttributeCollection

                Dim myEnt As Object = tr.GetObject(myAttId, OpenMode.ForRead)
                Dim myAtt As AttributeReference = myEnt
                If IsNothing(myAtt) = False Then
                    'Redim qui permet de délier les pointeurs à la variable.
                    'sans les supprimer.
                    ReDim FormatData(0 To Enum_GB_ExtAtt.Objet)
                    'si pas trouvé alors création
                    If debug = True Then doc.Editor.WriteMessage(vbCrLf & "TAG : " & myAtt.Tag)
                    FormatData(Enum_GB_ExtAtt.Key) = myAtt.Tag
                    If debug = True Then doc.Editor.WriteMessage(" / contenu : " & myAtt.TextString)
                    FormatData(Enum_GB_ExtAtt.Contenue) = myAtt.TextString
                    FormatData(Enum_GB_ExtAtt.Objet) = myAtt
                    If OkUnique = True Then
                        DataRet.Add(FormatData, myAtt.Tag)
                    Else
                        DataRet.Add(FormatData)
                    End If
                End If
            Next
            OkErreur = False
        Catch ex As Exception
            MsgBox("Le bloc : " & BlocRef.Name & " a un de ces attributs en défaut ou en double ! " & vbCrLf & _
                   "Vérifier le nom des attributs ou effectuer une synchronisation des blocs.", MsgBoxStyle.Information, "Erreur utilisateur")
            OkErreur = True
        Finally
            tr.Commit()
            tr.Dispose()
            tr = Nothing
        End Try
        If OkErreur = True Then
            'Raz Collection
            While DataRet.Count > 0
                Dim el As Object
                el = DataRet.Item(1)
                DataRet.Remove(1)
                el(Enum_GB_ExtAtt.Objet) = Nothing
                el = Nothing
            End While
            Return Nothing
        Else
            Return DataRet
        End If

    End Function
0 Likes