Loidy Posted March 13 Posted March 13 Good day, I am trying to make a table with legends (actual geometry). i have a code that can already create the table, populates the 1st column with block name, 2nd column layer names and 3rd column as count.. i want to convert the block names into real geometry or block shapes (like the TINSERT on a table cell).. thanks in advance.. here's my current code in autocad VBA.. Sub CountBlo1cksAndCreateTable() Dim acadDoc As Object Dim acadApp As Object Dim ss As Object Dim ent As Object Dim blkRef As Object Dim tbl As Object Dim pt As Variant Dim i As Integer Dim blkName As Variant Dim layerName As String Dim blkCounts As Object Dim blkLayers As Object Dim row As Integer Dim col As Integer ' Initialize AutoCAD Set acadApp = GetObject(, "AutoCAD.Application") Set acadDoc = acadApp.ActiveDocument ' Create dictionaries for block counts and layers Set blkCounts = CreateObject("Scripting.Dictionary") Set blkLayers = CreateObject("Scripting.Dictionary") ' Ask user to select objects On Error Resume Next Set ss = acadDoc.SelectionSets.Add("BlockSelection") If Err.number <> 0 Then Err.Clear Set ss = acadDoc.SelectionSets.Item("BlockSelection") ss.Clear End If On Error GoTo 0 ss.SelectOnScreen ' Loop through selected objects For i = 0 To ss.Count - 1 Set ent = ss.Item(i) ' Check if entity is a block reference If ent.ObjectName = "AcDbBlockReference" Then Set blkRef = ent blkName = blkRef.Name layerName = blkRef.layer ' Update block count dictionary If blkCounts.Exists(blkName) Then blkCounts(blkName) = blkCounts(blkName) + 1 Else blkCounts.Add blkName, 1 blkLayers.Add blkName, layerName ' Store layer name End If End If Next i ' Ask user for table insertion point pt = acadDoc.Utility.GetPoint(, "Select table insertion point: ") ' Let user pick insertion point ' Create table with dynamic row count Set tbl = acadDoc.modelSpace.AddTable(pt, blkCounts.Count + 2, 3, 10, 50) ' Set individual column widths tbl.SetColumnWidth 0, 3000 ' Block Name column tbl.SetColumnWidth 1, 2000 ' Layer Name column tbl.SetColumnWidth 2, 1000 ' Count column ' Set main header tbl.SetText 0, 0, "BLOCK COUNT" ' Set subheaders tbl.SetText 1, 0, "Block Preview" tbl.SetText 1, 1, "Layer" tbl.SetText 1, 2, "Count" ' Populate table with block data starting from row 2 row = 2 For Each blkName In blkCounts.Keys ' blkName must be a Variant tbl.SetText row, 0, blkName tbl.SetText row, 1, blkLayers(blkName) tbl.SetText row, 2, blkCounts(blkName) row = row + 1 Next blkName ' Clean up selection set ss.Clear acadDoc.SelectionSets.Item("BlockSelection").Delete End Sub Quote
Danielm103 Posted March 13 Posted March 13 Sorry I don’t have VBA installed, but from the docs: Use SetBlockTableRecordId to add a block to a cell If you want text and a block in the same cell , you’ll have to add an additional content CreateContent(nRow, nCol, nIndex) SetBlockTableRecordId2 nRow, nCol, nContent, blkId, autoFit nContent would be used like an array index Quote
BIGAL Posted March 13 Posted March 13 Another example code. (setq blks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq obj (vlax-ename->vla-object (car (entsel "\nPick object ")))) (vla-SetBlockTableRecordId Obj 2 2 (vla-get-objectid (vla-item blks "90LD")) :vlax-true) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.