TheSwamp
Code Red => VB(A) => Topic started by: jnieman on July 16, 2008, 06:18:55 PM
-
Does anyone know where I can find some good information about various controls and commands for creating/editting a table object in Autocad?
I'm creating a routine that will populate a table with X,Y coordinates for each instance of a certain block that's inserted into a drawing numerous times.
I have the coordinate extraction part down, I just need to know how to pass that information to a table that I create.
I searched through the Autodesk VBA book but it excludes tables altogether regarding object creation, and did some googling for a while, as well as searching these forums... I found some that almost help, but fell decidedly short.
Does anyone have a snippet I could examine or some functions I can look for?
The visual basic reference from the help menu is not being too helpful either (or I don't know the right place to look)
-
Here is one:
http://www.theswamp.org/index.php?topic=9730.0
It is ARX but might be easy to port (don't know) - but I guess you will end up moving or trying to use C# instead.
There are some .NET samples in the ARX SDK.... over here: www.objectarx.com
-
Thanks for the help, Luis, I got some good information that's already helped me.
Also, embarrassingly enough, I... was looking in the help accessed via the visual basic editor, and wow... big difference if you use the developer's help accessed from the main Autocad window!
*slams forehead on keyboard*
The entry for "Autocad table object" is quite robust.
-
Here is Q&D example but this will get
you started
Option Explicit
Sub Blocks_Table()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlk As AcadBlockReference
Dim varPt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim bName As String
Dim xStr As String
Dim yStr As String
Dim i As Long, j As Long
ftype(0) = 0: fdata(0) = "INSERT"
Dim dxfCode, dxfValue
dxfCode = ftype: dxfValue = fdata
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
oSset.SelectOnScreen dxfCode, dxfValue
Dim oSpace As AcadBlock
If ThisDrawing.ActiveSpace = acModelSpace Then
Set oSpace = ThisDrawing.ModelSpace
Else
Set oSpace = ThisDrawing.PaperSpace
End If
varPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify insertion point: ")
Dim oTable As AcadTable
Set oTable = oSpace.AddTable(varPt, oSset.Count + 2, 3, 10, 30)
ZoomExtents
With oTable
.RegenerateTableSuppressed = True
.SetCellTextHeight i, j, 5
.SetCellAlignment i, j, acMiddleCenter
.SetCellType i, j, acTextCell
.SetText 0, 0, "Blocks Position"
.SetCellType i, j, acTextCell
.SetText 1, j, "Block Name"
.SetCellTextHeight 1, j, 4.5
.SetText 1, j + 1, "X"
.SetCellTextHeight 1, j + 1, 4.5
.SetText 1, j + 2, "Y"
.SetCellTextHeight 1, j + 2, 4.5
For i = 0 To oSset.Count - 1
Set oEnt = oSset.Item(i)
Set oBlk = oEnt
If oBlk.IsDynamicBlock Then
bName = oBlk.EffectiveName
Else
bName = oBlk.Name
End If
xStr = Format(CStr(Round(oBlk.InsertionPoint(0), 3)), "#0.000")
yStr = Format(CStr(Round(oBlk.InsertionPoint(1), 3)), "#0.000")
.SetCellTextHeight i, j, 4
.SetCellAlignment i, j, acMiddleCenter
.SetText i + 2, j, bName
.SetCellTextHeight i + 2, j, 4#
.SetText i + 2, j + 1, xStr
.SetCellTextHeight i + 2, j + 1, 4#
.SetText i + 2, j + 2, yStr
.SetCellTextHeight i + 2, j + 2, 4#
Next i
.RegenerateTableSuppressed = False
.Update
End With
MsgBox "done"
End Sub
~'J'~
-
Here is Q&D example but this will get
you started
~'J'~
I just stepped through that and it has all the function that I require... I have the most trouble using selection sets but I think once I go through this and figure out what's doing what... I should be in good shape.
I appreciate this very much, you've helped me a great deal!
-
You're welcome
Cheers :)
~'J'~
-
I must thank you again fixo, you've been a godsend for this. The last hour I've spent on this was more productive than the 8 hours on and off I spent from the beginning!! (although I'm sure those beginning hours were needed to understand what was going on, this much)
I am having some trouble with my table creation. I'm trying to not have a single-column top row. I wish for it to be un-merged as the rest of the table is. I cannot see or find what it is in the definitions that make the top row into a single cell, rather than a cell for each column.
I can't figure it out. I've only learned how to merge cells using the "object.MergeCells(minRow, maxRow, minCol, maxCol) " method.
Option Explicit
Sub Blocks_Table()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlk As AcadBlockReference
Dim varPt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim bName As String
Dim xStr As String
Dim yStr As String
Dim i As Long, j As Long
ftype(0) = 0: fdata(0) = "INSERT"
Dim dxfCode, dxfValue
dxfCode = ftype: dxfValue = fdata
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
ThisDrawing.ActivePViewport.Display True
ThisDrawing.ActiveSpace = acModelSpace
oSset.SelectOnScreen dxfCode, dxfValue
ThisDrawing.ActiveSpace = acPaperSpace
Dim paSpace As AcadPaperSpace
Set paSpace = ThisDrawing.PaperSpace
varPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify insertion point: ")
Dim oTable As AcadTable
Set oTable = paSpace.AddTable(varPt, oSset.Count + 2, 5, 0.3, 1.5)
ZoomExtents
With oTable
.RegenerateTableSuppressed = True
.SetCellTextHeight i, j, 0.09375
.SetCellAlignment i, j, acMiddleCenter
.SetCellType i, j, acTextCell
.SetText 0, j, "ITEM"
.SetCellTextHeight i, j + 2, 0.09375
.SetText 0, j + 2, "EQUIPMENT DATUM"
.SetCellTextHeight i, j + 4, 0.09375
.SetText 0, j + 4, "DATUM LOCATION"
.SetText 1, j + 1, "N"
.SetCellTextHeight 1, j + 1, 0.09375
.SetText 1, j + 2, "E"
.SetCellTextHeight 1, j + 2, 0.09375
.SetText 1, j + 3, "EL"
.SetCellTextHeight 1, j + 3, 0.09375
For i = 0 To oSset.Count - 1
Set oEnt = oSset.Item(i)
Set oBlk = oEnt
If oBlk.IsDynamicBlock Then
bName = oBlk.EffectiveName
Else
bName = oBlk.Name
End If
xStr = Format(CStr(Round(oBlk.InsertionPoint(1), 3)), "#0.000")
yStr = Format(CStr(Round(oBlk.InsertionPoint(0), 3)), "#0.000")
.SetCellTextHeight i, j, 0.09375
.SetCellAlignment i, j, acMiddleCenter
.SetText i + 2, j, "-ID #-"
.SetCellTextHeight i + 2, j, 0.09375
.SetText i + 2, j + 1, xStr
.SetCellTextHeight i + 2, j + 1, 0.09375
.SetText i + 2, j + 2, yStr
.SetCellTextHeight i + 2, j + 2, 0.09375
Next i
.RegenerateTableSuppressed = False
.Update
End With
MsgBox "done"
End Sub
(also, interesting side note... FF3 crashed consistently when trying to paste the code directly from the VBA Manager in acad... I pasted it to notepad, and copied it over here successfully however.)
-
I am having some trouble with my table creation. I'm trying to not have a single-column top row. I wish for it to be un-merged as the rest of the table is. I cannot see or find what it is in the definitions that make the top row into a single cell, rather than a cell for each column.
I can't figure it out. I've only learned how to merge cells using the "object.MergeCells(minRow, maxRow, minCol, maxCol) " method.
Oh man, I'm not thinking 'outside the box'
It's set that way because the first row is of "Title" type in the table style. I assumed it defaulted to a "data" type, but since it's a title, it spans the whole table by default... it's not in the code, but the active table style *smacks forehead*
Now I gotta figure out how to set the first row as 'data' type, as opposed to title or header, now...
-
Glad you soved it by yourself
so I can rest :)
~'J'~
-
Fixo, I don't think you realize how much you're helping me today, beyond the post above!
Many times I have searched for how to get a certain thing to work (such as merging cells, amongst others) and doing a search on the Swamp has revealed that you already explained it to someone :-D
Your vba guidance on this forum is excellent!
I'm currently having trouble extracting the value of a defined attribute within that block, for placing into this same table... but I'm not given up quite yet.
-
ok I ended up giving up :(
I've looked over so many examples of people using GetAttributes that I cannot figure out what is going on... the help file does not seem to be very helpful, for me, either.
Below is the code I have so far.
The block I am going to be using for this table has a 3 or 4 attributes in it that hold information that will be passed to this table.
Tags:
ID
ELEVATION
DATUMLOC
DESC
I need to get the value for each individual attribute/tag and output it to a table cell exactly how I am doing with xStr and yStr as you have showed me.
Option Explicit
Sub Blocks_Table()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlk As AcadBlockReference
Dim varPt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim bName As String
Dim Atts As Variant
Dim xStr As String
Dim yStr As String
Dim ID As String
Dim Desc As String
Dim i As Long, j As Long
ftype(0) = 0: fdata(0) = "INSERT"
Dim dxfCode, dxfValue
dxfCode = ftype: dxfValue = fdata
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
ThisDrawing.ActivePViewport.Display True
ThisDrawing.ActiveSpace = acModelSpace
oSset.SelectOnScreen dxfCode, dxfValue
ThisDrawing.ActiveSpace = acPaperSpace
Dim paSpace As AcadPaperSpace
Set paSpace = ThisDrawing.PaperSpace
varPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify insertion point: ")
Dim oTable As AcadTable
Set oTable = paSpace.AddTable(varPt, oSset.Count + 3, 6, 0.3, 1.5)
oTable.TitleSuppressed = False
oTable.HeaderSuppressed = True
ZoomExtents
With oTable
.RegenerateTableSuppressed = True
.SetCellTextHeight i, j, 0.15625
.SetCellAlignment i, j, acMiddleCenter
.SetCellType i, j, acTextCell
.SetText 0, 0, "EQUIPMENT LAYOUT SCHEDULE"
.SetText 1, 0, "ITEM"
.SetCellTextHeight 1, 0, 0.09375
.SetText 1, 1, "EQUIPMENT DATUM"
.SetCellTextHeight 1, 1, 0.09375
.SetText 1, 4, "DATUM LOCATION"
.SetCellTextHeight 1, 4, 0.09375
.SetText 1, 5, "DESCRIPTION"
.SetCellTextHeight 1, 5, 0.09375
.SetText 2, 1, "N"
.SetCellTextHeight 2, 1, 0.09375
.SetText 2, 2, "E"
.SetCellTextHeight 2, 2, 0.09375
.SetText 2, 3, "EL"
.SetCellTextHeight 2, 3, 0.09375
For i = 0 To oSset.Count - 1
Set oEnt = oSset.Item(i)
Set oBlk = oEnt
If oBlk.IsDynamicBlock Then
bName = oBlk.EffectiveName
Else
bName = oBlk.Name
End If
xStr = Format(CStr(Round(oBlk.InsertionPoint(1), 3)), "#0.000")
yStr = Format(CStr(Round(oBlk.InsertionPoint(0), 3)), "#0.000")
.SetCellTextHeight i + 3, j, 0.09375
.SetCellAlignment i + 3, j, acMiddleCenter
.SetText i + 3, j, ID
.SetCellTextHeight i + 3, j, 0.09375
.SetText i + 3, j + 1, xStr
.SetCellTextHeight i + 3, j + 1, 0.09375
.SetText i + 3, j + 2, yStr
.SetCellTextHeight i + 3, j + 2, 0.09375
.SetText i + 3, j + 3, Desc
.SetCellTextHeight i + 3, j + 3, 0.09375
Next i
.RegenerateTableSuppressed = False
.Update
End With
oTable.MergeCells 1, 2, 0, 0
oTable.MergeCells 1, 2, 4, 4
oTable.MergeCells 1, 2, 5, 5
oTable.MergeCells 1, 1, 1, 3
MsgBox "Yahoooooo!"
End Sub
-
Right now I have not set a value to ID or DESC, but I'm not sure how to even do so.
-
Upload your sample drawing with blocks
(delete unused information and other things before)
I'll look at it tomorrow
~'J'~
-
Here is everything necessary.
From what it seems... I think my problem is that I don't know how to handle arrays to get the information I need :(
test.dwg
Contains the block "DATUM" in model space in a variety of instances.
I select all those blocks during the routine, it switches to paperspace, asks for the insertion point of the table, and then creates it.
I just don't know how to get the value of the attributes and then put them into the table.
Thank you very much for your time!
-
fixo!
Please do not spend any more of your time on me!
JeffM gave me the final push in understanding what's going on with GetAttributes that I wasn't able to understand.
http://www.theswamp.org/index.php?topic=24004.0 is where I have the final entire code.
if you have comments, lessons, advice, I welcome it, but I won't ask any more of your time for this... you've done quite a lot already and I owe the success to you (and Jeff M) for sure!
-
Jeff M is my teacher too :)
Sorry I could not be able to explain the things
that you asked for becuase of my poor English level
Better yet I will to write the code you need :)
and Jeff M will explain it much better :)
(Change the text height, layout name etc to your suit)
Private Sub MakeTableStyle()
' creates a TableStyle object
Dim oDict As AcadDictionary
Dim aColor As New AcadAcCmColor
Dim oTblSty As AcadTableStyle
Dim sKeyName As String
Dim sClassName As String
'grab the tablestyle dictionary object
Set oDict = ThisDrawing.Database.Dictionaries.Item("acad_tablestyle")
sKeyName = "Block Table"
sClassName = "AcDbTableStyle"
'create the TableStyle object in the dictionary
Set oTblSty = oDict.AddObject(sKeyName, sClassName)
With oTblSty
.Name = "Block Table"
.Description = "Style For The Block Info"
.HorzCellMargin = 0.03
.TitleSuppressed = False
.SetTextHeight 3, 0.93625
.SetGridVisibility 3, 3, True
.SetAlignment 3, acMiddleCenter
aColor.SetRGB 244, 0, 0
End With
End Sub
Sub BlockToTable()
Dim oTable As AcadTable
Dim oEnt As AcadEntity
Dim fstRef As AcadBlockReference
Dim blkRef As AcadBlockReference
Dim bname As String
Dim varPt As Variant
Dim attVar() As Object
Dim attObj As AcadAttributeReference
Dim row As Long, col As Long
Dim i As Long, j As Long
Dim tmpStr As String
Dim attColl As Collection
Dim acCol As New AcadAcCmColor
On Error GoTo Err_Control
If ThisDrawing.ActiveSpace = acPaperSpace Then
ThisDrawing.ActiveSpace = acModelSpace
End If
On Error Resume Next
ThisDrawing.Utility.GetEntity oEnt, varPt, vbCrLf & "Select block to import data to table"
If Err Then
Err.Clear
End If
On Error GoTo 0
If Not oEnt Is Nothing Then
If TypeOf oEnt Is AcadBlockReference Then
Set blkRef = oEnt
End If
End If
If Not blkRef.HasAttributes Then
MsgBox "This block does not have an attributes"
Exit Sub
End If
If blkRef.IsDynamicBlock Then
bname = blkRef.EffectiveName
Else
bname = blkRef.Name
End If
Dim oSset As AcadSelectionSet
Dim ftype(1) As Integer
Dim fdata(1) As Variant
Dim dxfCode, dxfValue
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
ftype(0) = 0: ftype(1) = 2
fdata(0) = "INSERT": fdata(1) = bname
dxfCode = ftype: dxfValue = fdata
oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
MsgBox oSset.Count
Set oEnt = oSset.Item(0)
Set fstRef = oEnt
attVar = fstRef.GetAttributes
ReDim tmp(0 To UBound(attVar) + 1) As String
Set attColl = New Collection
tmp(0) = "Block Name"
For i = 0 To UBound(attVar)
tmp(i + 1) = attVar(i).TagString
Next
attColl.Add tmp, "headers"
For j = 1 To oSset.Count
Set oEnt = oSset.Item(j - 1)
Set blkRef = oEnt
attVar = blkRef.GetAttributes
tmp(0) = bname
For i = 0 To UBound(attVar)
tmp(i + 1) = attVar(i).TextString
Next
attColl.Add tmp, "row " & CStr(j)
Next j
Call MakeTableStyle
ThisDrawing.ActiveLayout = ThisDrawing.Layouts("C-02") '<--change the tab name here
DoEvents
Dim pt As Variant
pt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Pick the upper left point of table:")
Set oTable = ThisDrawing.PaperSpace.AddTable(pt, oSset.Count + 2, UBound(tmp) + 1, 2.5, 10)
oTable.RegenerateTableSuppressed = True
oTable.HorzCellMargin = 0.03
oTable.TitleSuppressed = False
oTable.HeaderSuppressed = False
oTable.SetTextHeight 7, 0.18
row = 0
col = 0
acCol.SetRGB 143, 189, 164
tmpStr = "Block Attributes Info"
oTable.SetRowHeight row, 0.25
oTable.SetCellTextHeight row, col, 0.18
oTable.SetCellBackgroundColor row, col, acCol
acCol.SetRGB 173, 43, 0
oTable.SetCellContentColor row, col, acCol
oTable.SetText row, col, tmpStr
oTable.SetCellAlignment row, col, acMiddleCenter
row = 1
oTable.SetRowHeight row, 0.25
For i = 0 To UBound(tmp)
acCol.SetRGB 236, 237, 238
oTable.SetCellTextHeight row, i, 0.15
oTable.SetCellBackgroundColor row, i, acCol
acCol.SetRGB 0, 0, 180
oTable.SetCellContentColor row, i, acCol
tmpStr = attColl.Item(1)(i)
If i <> UBound(tmp) Then
oTable.SetColumnWidth i, 2#
Else
oTable.SetColumnWidth i, 3#
End If
oTable.SetText row, i, tmpStr
oTable.SetCellAlignment row, i, acMiddleCenter
acCol.SetRGB 0, 0, 180
Next
For row = 2 To attColl.Count
oTable.SetRowHeight row, 0.21
For i = 0 To UBound(tmp)
acCol.SetRGB 236, 237, 238
oTable.SetCellTextHeight row, i, 0.12
oTable.SetCellBackgroundColor row, i, acCol
acCol.SetRGB 0, 0, 180
oTable.SetCellContentColor row, i, acCol
tmpStr = attColl.Item(row)(i)
If i <> UBound(tmp) Then
oTable.SetColumnWidth i, 2#
Else
oTable.SetColumnWidth i, 3#
End If
oTable.SetText row, i, tmpStr
oTable.SetCellAlignment row, i, acMiddleCenter
Next
Next
oTable.RegenerateTableSuppressed = False
Set acCol = Nothing
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
~'J'~
-
Wow, that's some great additions!
The error handling is so simple and easy to understand... that was one of the things I planned on adding in as I go, so thank you for saving me from searching for a solution.
I read through it all, slowly, and you've given me some extra tools to use, thank you.
I like how you changed how I counted attributes. Before I had to set a new integer (c) to count with, rather than using the previous (i) because I did not know how to add the attributes, and it was giving me wrong output when I tried. I knew my method was not the best, so thank you for showing me the right way.
I have one question though. I am currently trying to find a solution. How can I take the array of object in a selection set... and reverse the order?
To explain: When it creates the table, it places the information starting with the block I placed LAST, and then descending in order to the block I placed FIRST... I wonder: is there a way to reverse the order it reads the attributes and dxf codes as it loops? I guess I'm wanting to loop in reverse order. I've tried a couple guesses but they've failed.
-
I have one question though. I am currently trying to find a solution. How can I take the array of object in a selection set... and reverse the order?
This small change will do that, Josh. The code between the first & last lines is all I modified. This Steps thru the SS from the end to the the beginning.
'<snip>
attColl.Add tmp, "headers"
Dim idx As Integer
idx = 0
For j = oSset.Count To 1 Step -1
Set oEnt = oSset.Item(j - 1)
Set blkRef = oEnt
attVar = blkRef.GetAttributes
tmp(0) = bname
For i = 0 To UBound(attVar)
tmp(i + 1) = attVar(i).TextString
Next
idx = 1 + idx
attColl.Add tmp, "row " & CStr(idx)
Next j
Call MakeTableStyle
'<snip>
-
I like how you changed how I counted attributes. Before I had to set a new integer (c) to count with, rather than using the previous (i) because I did not know how to add the attributes, and it was giving me wrong output when I tried. I knew my method was not the best, so thank you for showing me the right way.
FYI, your method was just fine, based on the example I showed you. What ~'J'~ did was streamline how the table data was added to it which, in turn, changed how the data was gathered. That is why he was able to re-use the counter. Note that he still used 2 counters, though, I & J, just in different ways. :-)
-
Ah, I see, then, Jeff. I guess when I used another integer I thought that there must've been a more elegant way, but did not push too hard for elegance, since I'm a beginner.
I don't have time for now to get the reverse put in there, but will add that in soon. I was approaching the method of counting wrong.
Thanks again to both of you for the extremely helpful guidance and support. Couldn't have done this without you guys.