Hi,
After searching for a long time on the web, does anyone know how to get the block's layer name?
I iterate through Blocks to get informations but i'm not able to code the source to obtain what i want?
Sample source taken from AutoCAD.NET site:
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() '' Open the Block table for read Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead) '' Open the Block table record Model space for read Dim acBlkTblRec As BlockTableRecord acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead) '' Step through the Block table record For Each acObjId As ObjectId In acBlkTblRec acDoc.Editor.WriteMessage(vbLf & "DXF name: " & acObjId.ObjectClass().DxfName) acDoc.Editor.WriteMessage(vbLf & "ObjectID: " & acObjId.ToString()) acDoc.Editor.WriteMessage(vbLf & "Handle: " & acObjId.Handle.ToString()) acDoc.Editor.WriteMessage(vbLf) Next '' Dispose of the transaction End Using
Maybe use nested transaction to iterate through LayerTableId?
ideas?
Try this function to get the block name
Public Shared Function EffectiveName(blkref As BlockReference) As String If blkref.IsDynamicBlock Then Using obj As BlockTableRecord = DirectCast(blkref.DynamicBlockTableRecord.GetObject(OpenMode.ForRead), BlockTableRecord) Return obj.Name End Using End If Return blkref.Name End Function
~'J'~
Hi Hallex,
I don't want to get the block's name but the layer's name on which the block is attached!
Thanks a lot.
Sorry for that
To get a layer you have to cast object as Entity, something like:
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() '' Open the Block table for read Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead) '' Open the Block table record Model space for read Dim acBlkTblRec As BlockTableRecord acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead) '' Step through the Block table record For Each acObjId As ObjectId In acBlkTblRec Dim ent As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead) acDoc.Editor.WriteMessage(vbLf & "DXF name: " & acObjId.ObjectClass().DxfName) acDoc.Editor.WriteMessage(vbLf & "ObjectID: " & acObjId.ToString()) acDoc.Editor.WriteMessage(vbLf & "Handle: " & acObjId.Handle.ToString()) acDoc.Editor.WriteMessage(vbLf & "Layer: " & ent.Layer.ToString()) acDoc.Editor.WriteMessage(vbLf) Next ''Dispose of the transaction End Using
~'J'~
What the...
It was so easy that i didn't see it! I'll try this.
You're the fastest and the best Hallex!
See you.
PS: I'm French, so all apollogies to my syntaxe script.
Hi Hallex,
How are you? I have a new matter that i cannot solve.
You helped me to find le layer's name of a block.
Now i would like to find property's block (AcadObject: Polyline, Arc....). For instance for each block in a particular layer, iterate through each ones, then showing all properties like length, boundary closed or opened, width....
'Compte du nombre d'objet(s) dans le calque séléctionné' Using acTrans = acDocs.MdiActiveDocument.Database.TransactionManager.StartTransaction() acBlkTbl = acTrans.GetObject(acDocs.MdiActiveDocument.Database.BlockTableId, OpenMode.ForRead) acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead) For Each acObjId As ObjectId In acBlkTblRec Dim MyEnt As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead) If MyEnt.Layer = LayerVal Then 'MsgBox(acObjId.ObjectClass.DxfName) Select Case acObjId.ObjectClass.DxfName '*******' '* ARC *' '*******' Case Is = "ARC" 'LENGTH' MsgBox (?) Case Is = "CIRCLE" Case Is = "DIMENSION" Case Is = "HATCH" Case Is = "LINE" Case Is = "LWPOLYLINE" Case Is = "MTEXTE" Case Is = "POINT" Case Is = "RAY" Case Is = "REGION" Case Is = "TEXTE" Case Is = "SPLINE" Case Is = "XLINE" End Select End If Next acObjId End Using End With
Do you have any ideas?
This will get you started, I have no time on complete solution
Change properties for every type what you'll want to retrieve
Here is just a quick example:
<CommandMethod("getsubentitiesinfo", "GetS", CommandFlags.Modal)> _ Public Shared Sub explodeRef() Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim info As String = "" Dim opts As New PromptEntityOptions(vbLf & "Select block reference") opts.SetRejectMessage(vbLf & "Select only type of block reference!") opts.AddAllowedClass(GetType(BlockReference), False) Dim res As PromptEntityResult = ed.GetEntity(opts) If res.Status <> PromptStatus.OK Then Return Using tr As Transaction = db.TransactionManager.StartTransaction() Dim bref As BlockReference = TryCast(tr.GetObject(res.ObjectId, OpenMode.ForRead), BlockReference) Dim expobjs As New DBObjectCollection() bref.Explode(expobjs) Dim table As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) For Each obj As DBObject In expobjs If TypeOf obj Is Entity Then Select Case obj.GetRXClass().DxfName Case "LWPOLYLINE" info = "" Dim poly As Polyline = TryCast(obj, Polyline) info = String.Format(vbLf + "Number of points: {0}" + vbLf + "Closed? {1}" + vbLf + "Layer: {2}" + vbLf + "Color: {3}", poly.NumberOfVertices, poly.Closed, poly.Layer, poly.ColorIndex) Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(info) Case "ARC" info = "" Dim arc As Arc = TryCast(obj, Arc) info = String.Format(vbLf + "Center: {0}" + vbLf + "Start angle: {1}" + vbLf + "End angle: {2}" + vbLf + "Start point{3}" + vbLf + "End point: {4}" + vbLf + "Layer: {5}" + vbLf + "Color: {6}", arc.Center, arc.StartAngle, arc.EndAngle, arc.StartPoint, arc.EndPoint, arc.Layer, arc.ColorIndex) Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(info) ''ETC..ETC... Case "CIRCLE" Case "DIMENSION" Case "HATCH" Case "LINE" Case "LWPOLYLINE" Case "MTEXT" Case "POINT" Case "RAY" Case "REGION" Case "TEXT" Case "SPLINE" Case "XLINE" End Select End If Next 'clean up memory, optional For Each obj As DBObject In expobjs obj.Dispose() Next tr.Commit() End Using End Sub
~'J'~
Hi Hallex,
I'm very surprised you're very quick! Thank you.
Now i have to understand code and work on it.
See you!
Good to hear that,
Just a hint, you could be able to collect all of values of the particular subentity
into the
List(Of (List (Of String))
( every single item inside into the List (of String)),
then this would be easier to write to the data file on another storage,
hth,
~'J'~
Hi Hallex, how are you?
I try de write the best code to obtain what i want but when i run it on AutoCAD, i have a dialog box error.
So in a module vars.
Module Paramètres '********************************' '* Paramètres du Document Actif *' '********************************' Public acDocs As DocumentCollection = Application.DocumentManager Public acDoc As Document = acDocs.MdiActiveDocument Public acCurDb As Database = acDoc.Database Public acTrans As Transaction
Public acBlkTbl As BlockTable
Public acBlkTblRec As BlockTableRecord
End Module
And the code
Sub ExcelApp(ByVal LayerVal) '***********************' '* Génération du fichier Excel *' '***********************'
Using acTrans = acCurDb.TransactionManager.StartTransaction() acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead) acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead)
For Each acObjId As ObjectId In acBlkTblRec Dim MyEnt As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead) If MyEnt.Layer = LayerVal Then Select Case acObjId.ObjectClass.DxfName '******' '* ARC *' '******' Case Is = "ARC" Dim MyArc As AcadArc = CType(acTrans.GetObject(MyEnt.AcadObject, OpenMode.ForRead), AcadArc) MsgBox(MyArc.ArcLength) End If Next acObjId
End Using
Error message: Impossible to cast type's object.
'Autodesk.AutoCAD.DatabaseServices.Arc' to 'Autodesk.AutoCAD.Interop.Common.AcadArc'
Am i on the right way?
Hi all,
I just found what's wrong in my source code!
Change these lines:
Dim MyArc As AcadArc = CType(acTrans.GetObject(MyEnt.AcadObject, OpenMode.ForRead), AcadArc) MsgBox(MyArc.ArcLength)
by:
Dim MyArc As Autodesk.AutoCAD.DatabaseServices.Arc = TryCast(MyEnt, Entity) MsgBox (MyArc.Length)
Thanks to Hallex!
Glad you solved it by yourself,
Happy coding
~'J'~
Hi,
I've met another matter!
When I iterate through specifics entities (like LWPOLYLINE, LINE, CIRCLE,...etc) sometimes my source code deal with "POINT". So I would like to cast it to obtain coordinates (X, Y, Z).
Dim MyPoint As Point3d = TryCast(MyEnt, Entity)
But the matter is I cannot access coordinate of these entity, cause Point3d belongs to Autodesk.AutoCAD.Geometry whereas MyEnt belong to AutoDesk.AutoCAD.DatabaseServices
How could I reach these informations?
You could be able to get coordinates from polyline
with help of these functions:
''============================= LWPolyline ======================= Public Shared Function getAllVertices(ByVal ent As Polyline) As Point2dCollection Dim verCollection As Point2dCollection = New Point2dCollection() Dim vertex As Point2d Dim i As Integer = 0 For i = 0 To ent.NumberOfVertices - 1 vertex = ent.GetPoint2dAt(i) verCollection.Add(vertex) Next Return verCollection End Function ''============================= 3dPoly ======================= Public Shared Function Get3dPolyVertices(ByVal poly3d As Polyline3d) As Point3dCollection Dim pts As New Point3dCollection For i As Integer = 0 To poly3d.EndParam pts.Add(poly3d.GetPointAtParameter(i)) Next i Return pts End Function
From line you can get coordinates:
Dim sp as point3d= line.StartPoint
dim ep as point3d= line.EndPoint
same way for arc,circle etc
just find in Intellisence box appropriate properties for them all
~'J'~
Hi Hallex,
I had found another way to obtain coords.
Case Is = "POINT" '*********' '* POINT *' '*********' 'Insertion du texte' acMText = New MText() Dim X as Double = MyEnt.GeometricExtents.MinPoint.X Dim Y as Double = MyEnt.GeometricExtents.MinPoint.Y Dim Z as Double = MyEnt.GeometricExtents.MinPoint.Z With acMText acMText.SetDatabaseDefaults() acMText.Location = New Point3d(X, Y, Z) acMText.Attachment = AttachmentPoint.BottomLeft acMText.TextHeight = acHeightText acMText.Contents = i End With acBlkTblRec.AppendEntity(acMText) acTrans.AddNewlyCreatedDBObject(acMText, True) 'Libération de la variable' MyEnt = Nothing acMText = Nothing
But what the difference between "MinPoint" and "MaxPoint"? I tried twice and it gaves the same result!
Thank You.
Can't find what you're looking for? Ask the community or share your knowledge.