I want to export blockcell's image in table object
While in my reply to your previous post I said "no", I meant it is not directly. But now that you mentioned to use AcadDocument.Export() method, then I think you can try this in indirect way, with following steps:
1. Find the block definition of the block reference used in a table cell (as Ed_Jobe's reply showed);
2. Find a spot somewhere in the ModelSpace/PaperSpace, where it is clean, and insert a block reference of the block, with proper scale;
3. Zoom to the inserted block reference properly;
4. Add the block reference to a SelectionSet
5. Call the AcadDocument.Export() method to save it as *.wmf, or *.bmp;
6. Erase the block reference
You can repeat the steps for each of the block reference cell in the table.
Are you say that the block references in the tables are dynamic block references from the same block definition, but the dynamic property or properties being set to different values (thus the block references look differently)?
If so, for each table cell, you not only find out its block definition, but also its property value(s). Then when inserting the temporary block reference for exporting image, you can set the property value(s) accordingly before doing the export.
Accepted solution
Well, I don't entirely understand your situation and what exactly you need. But using AcadDocument.Export() to generate entity/block reference image is doable as I suggested. I happened to have a bit time to play it a bit and following code came out working:
Option Explicit
Public Sub GetBlocksInTable()
Dim ent As AcadEntity
Dim pt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select table entity:"
If ent Is Nothing Then Exit Sub
Dim tbl As AcadTable
If TypeOf ent Is AcadTable Then
Set tbl = ent
ProcessBlocksInTable tbl
End If
End Sub
Private Sub ProcessBlocksInTable(table As AcadTable)
Dim i As Integer
Dim j As Integer
Dim cellType As AcCellType
For i = 1 To table.Rows - 1
For j = 0 To table.Columns - 1
cellType = table.GetCellType(i, j)
If cellType = acBlockCell Then
WorkOnCell table, i, j
End If
Next
Next
End Sub
Private Sub WorkOnCell(table As AcadTable, row As Integer, column As Integer)
Dim blockId As LongPtr
Dim blkNames() As String
Dim i As Integer
blockId = table.GetBlockTableRecordId(row, column)
Dim blk As AcadBlock
For Each blk In ThisDrawing.Blocks
If blk.ObjectID = blockId Then
''MsgBox "Block name: " & blk.Name
ReDim Preserve blkNames(i)
blkNames(i) = blk.Name
i = i + 1
End If
Next
If i = 0 Then
MsgBox "No block found in table!"
Exit Sub
End If
'' Save current view - code ommitted
'' Exporting block imagaes
ExportBlockImages blkNames
'' Restore saved view - code omitted
End Sub
Private Sub ExportBlockImages(blkNames As Variant)
Dim i As Integer
Dim blkName As String
Dim exportPath As String
exportPath = "C:\Temp\"
For i = 0 To UBound(blkNames)
blkName = blkNames(i)
ExportBlockImage blkName, exportPath
Next
End Sub
Private Sub ExportBlockImage(blkName As String, exportPath As String)
'' Insert block at 0,0
Dim blkRef As AcadBlockReference
Dim insPoint(0 To 2) As Double
insPoint(0) = 0#: insPoint(1) = 0#: insPoint(2) = 0#
Set blkRef = ThisDrawing.ModelSpace.InsertBlock(insPoint, blkName, 1#, 1#, 1#, 0#)
blkRef.Update
ZoomToBlock blkRef
'' export
DoImageExport blkRef, exportPath & blkName
blkRef.Delete
End Sub
Private Sub ZoomToBlock(blk As AcadBlockReference)
Dim minPt As Variant
Dim maxPt As Variant
blk.GetBoundingBox minPt, maxPt
Dim minP(0 To 2) As Double
Dim maxP(0 To 2) As Double
Dim deltaH As Double
Dim deltaW As Double
deltaW = (maxPt(0) - minPt(0)) * 0.1
deltaH = (maxPt(1) - minPt(1)) * 0.1
minP(0) = minPt(0) - deltaW: minP(1) = minPt(1) - deltaH: minP(2) = minPt(2)
maxP(0) = maxPt(0) + deltaW: maxP(1) = maxPt(1) + deltaH: maxP(2) = maxPt(2)
ZoomWindow minP, maxP
ThisDrawing.Utility.GetString 0, vbCr & "Exporting block """ & blk.Name & """. Press Enter to continue..."
End Sub
Private Sub DoImageExport(blk As AcadBlockReference, fileName As String)
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets.Add("mySet")
If Err.Number <> 0 Then
Err.Clear
Set ss = ThisDrawing.SelectionSets("MySet")
End If
Dim ents() As AcadEntity
ReDim ents(0)
Set ents(0) = blk
ss.AddItems ents
ThisDrawing.Export fileName, "bmp", ss
ss.Delete
End Sub
This video clip shows the code in action:
Of course you may need to resize AutoCAD's window, its drawing background... to make the exported image in desired condition (size/back color...). Hope this helps a bit.
Again, I do not know what your situation is, cant say more. You might want to post/attach your drawing to make things clearer.
When you model in modelspace, the view is usually 2Dwireframe. Just change it to the style you want, export the bmp, then change it back to 2Dwireframe. you can use the VSCURRENT command.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.