PDA

View Full Version : Solved: Another AutoCad to Excel Question



KennyJ
06-18-2008, 11:24 AM
Sorry guys I have tried a lot of scripts from all over the internet including here and always seem to catch errors or other problems. I need to get Parts Lists from AutoCad 2008 Drawings to Excel. I attached an example of how we make parts lists to this post. Everything should be in PaperSpace and in Mtext format.

My idea of how it should work would be.
1.) run the macro from autocad
2.) select the part list
3.) export the text to Excel
4.) save the excel file as the same name as the drawing file

Sorry for asking what seems to be answered all over the internet I just cant seem to get anything to work for me.

Tommy
06-19-2008, 07:31 AM
Where are you having problems? Could you post some code that seems to work and describe the problems?

I have written a bom editor (in model space) that "works", but I don't like the way it interfaces with excel, it is very slow and I don't have a slow machine :(

fixo
06-19-2008, 03:54 PM
Sorry guys I have tried a lot of scripts from all over the internet including here and always seem to catch errors or other problems. I need to get Parts Lists from AutoCad 2008 Drawings to Excel. I attached an example of how we make parts lists to this post. Everything should be in PaperSpace and in Mtext format.

My idea of how it should work would be.
1.) run the macro from autocad
2.) select the part list
3.) export the text to Excel
4.) save the excel file as the same name as the drawing file

Sorry for asking what seems to be answered all over the internet I just cant seem to get anything to work for me.

This should get you started just add the part
to save Excel file as you want



Sub ExportBOMTable()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oText As AcadMText
Dim eCnt As Integer
Dim iCnt As Integer
Dim rCnt As Integer
Dim iNdx As Integer
Dim jNdx As Integer
Dim insPnt() As Double
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim setName As String
fcode(0) = 0
fData(0) = "MTEXT"
dxfcode = fcode
dxfdata = fData
setName = "$TEXT$"
MsgBox "Select desired piece of table" & vbNewLine & _
"by window selection w/o very lower row"
rCnt = InputBox(vbNewLine & vbNewLine & "Enter number of columns" & vbNewLine & _
"Press enter to set default: ", "Number Of Columns", "4")
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen dxfcode, dxfdata
iCnt = oSset.Count
ReDim SelPnt(0 To iCnt - 1, 0 To 3) As Variant
eCnt = 0
For Each oEnt In oSset
Set oText = oEnt
insPnt = oText.InsertionPoint
SelPnt(eCnt, 0) = insPnt(0)
SelPnt(eCnt, 1) = insPnt(1)
SelPnt(eCnt, 2) = insPnt(2)
SelPnt(eCnt, 3) = oText.TextString
eCnt = eCnt + 1
Next oEnt
Dim collPts As Collection
Set collPts = New Collection
ReDim sortpnt(0 To (iCnt - 1), 0 To 2) As Variant
sortpnt = ColSort(SelPnt, 2) '<--sort by X
ReDim tmpsort(0 To rCnt - 1, 0 To UBound(sortpnt, 2)) As Variant
Dim itmArr As Variant
eCnt = 0
For iCnt = 0 To UBound(sortpnt, 1) Step rCnt
iNdx = 0
Do While iNdx < rCnt
For jNdx = 0 To UBound(sortpnt, 2)
tmpsort(iNdx, jNdx) = sortpnt(eCnt, jNdx)
Next
eCnt = eCnt + 1
iNdx = iNdx + 1
Loop
itmArr = ColSort(tmpsort, 1)
collPts.Add itmArr, "Row" & CStr(iCnt)
Next
Dim collTxt As Collection
Set collTxt = New Collection
icol = UBound(sortpnt, 2)
For iNdx = 1 To collPts.Count
For jNdx = 0 To UBound(tmpsort, 1)
collTxt.Add collPts.Item(iNdx)(jNdx, icol)
Next
Next
'===================== excel part ============'

Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim strFilePath As String
'//strFilePath = ThisDrawing.Path & "\Bom.xls"
On Error Resume Next
Err.Clear
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Cannot start Excel", vbExclamation
End
End If
End If
xlApp.Visible = True
'//Set xlBook = xlApp.Workbooks.Open(strFilePath)
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
On Error GoTo Err_control
Dim irow As Long
irow = collTxt.Count \ rCnt
jNdx = 1
icol = UBound(sortpnt, 2)
With xlSheet
.Range("A:A").NumberFormat = "@"
For iNdx = 1 To collTxt.Count Step rCnt
jNdx = 1
.Cells(irow, jNdx) = collTxt.Item(iNdx)
.Cells(irow, jNdx + 1) = collTxt.Item(iNdx + 1)
.Cells(irow, jNdx + 2) = collTxt.Item(iNdx + 2)
.Cells(irow, jNdx + 3) = collTxt.Item(iNdx + 3)
irow = irow - 1
Next iNdx

.Columns.AutoFit
.UsedRange.Select
With Selection
.Font.color = vbBlue
.Interior.ColorIndex = 35
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlHAlignLeft
.Range("1:1").Font.Bold = True
.Range("1:1").Font.color = vbRed
End With
End With
Err_control:
MsgBox Err.Description
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' written by Fatty T.O.H. (c)2006 * all rights removed '
' SourceArr - two dimensional array '
' iPos - column number to sort (starting from 1) '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function ColSort(SourceArr As Variant, iPos As Integer) As Variant
Dim Check As Boolean
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
Dim iCount As Integer
Dim jCount As Integer
Dim nCount As Integer
iPos = iPos - 1
Check = False
Do Until Check
Check = True
For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
If SourceArr(iCount, iPos) > SourceArr(iCount + 1, iPos) Then
For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
tmpArr(jCount) = SourceArr(iCount, jCount)
SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
SourceArr(iCount + 1, jCount) = tmpArr(jCount)
Check = False
Next
End If
Next
Loop
ColSort = SourceArr
End Function


~'J'~

KennyJ
06-19-2008, 05:48 PM
I get an error. Is there any setting up i need to do? I think I might have tried this macro before and did'nt understand how to get it to run.:doh:

'===================== excel part ============'

Dim xlApp As Excel.Application

Error:

"User-defined type not defined"

fixo
06-19-2008, 11:27 PM
I get an error. Is there any setting up i need to do? I think I might have tried this macro before and did'nt understand how to get it to run.:doh:

'===================== excel part ============'

Dim xlApp As Excel.Application

Error:

"User-defined type not defined"



Request reference to Microsoft Excel XX.0 Object Library
nothing else


~'J'~

fixo
06-19-2008, 11:33 PM
Well, it ran for me so I'm going to guess that your VBAIDE options are set
to Break On All Errors.
Change it to Break on Unhandled Errors and see what happens.

~'J'~

Tommy
06-20-2008, 05:07 AM
It ran fine for me after I added the reference to excel.

KennyJ
06-20-2008, 05:36 AM
Request reference to Microsoft Excel XX.0 Object Library
nothing else

~'J'~
This shows up red in my VBA editor and doesn't compile. And I am set to Break on Unhandled Errors.

fixo
06-20-2008, 06:59 AM
What the line of code is shows up in red?

~'J'~

KennyJ
06-20-2008, 07:10 AM
Yes. Am I supposed to copy and paste the line you put above into my editor? or is there more to it than that?

thank you and sorry for the rookie questions but my job has me on mission impossible trying to extract 1000s of these Boms and I dont want to do it all manually.

fixo
06-20-2008, 07:20 AM
Can you upload your working drawing with table here?
Just remove from all unused stuffs for this programm
I mean blocks, title blocks, company information etc.
I'll try to write the complete project on weekends

~'J'~

KennyJ
06-20-2008, 07:33 AM
I attached an example of our Bom to my original post. That is everything minus the drawing and block.

Tommy
06-20-2008, 07:51 AM
Hi KennyJ,
In the VBAIDE (where the code is LOL) pick Tolls->References then in the dialog box the pops up scroll down until you find "Microsoft Excel 11.0 Object Library" and select the checkbox beside it. This will allow the code that Fatty has posted to run without error. The attached file has the references selected for this project, in case you are not sure how to do what I have described. If you need futher help let us know.

fixo
06-20-2008, 07:52 AM
Yes. Am I supposed to copy and paste the line you put above into my editor? or is there more to it than that?

thank you and sorry for the rookie questions but my job has me on mission impossible trying to extract 1000s of these Boms and I dont want to do it all manually.

Better yet to add all references and
then compile all things into one project
(create DVB file)
After you close drawing just click Ok when
the messagebox will appears and then create project
with desired name, say ExportBOM or so
Sorry for my poor english, I never learned them :)

~'J'~

KennyJ
06-20-2008, 10:09 AM
Hi KennyJ,
In the VBAIDE (where the code is LOL) pick Tolls->References then in the dialog box the pops up scroll down until you find "Microsoft Excel 11.0 Object Library" and select the checkbox beside it. This will allow the code that Fatty has posted to run without error. The attached file has the references selected for this project, in case you are not sure how to do what I have described. If you need futher help let us know.

This worked perfect! :thumb

Thank all of you for helping me now I can get to work...:doh:

noyjoreb
03-29-2010, 08:06 AM
kenny j can u send me also that code? or any sample of your autocad file which can be imported to excel? thanks in advance...




I get an error. Is there any setting up i need to do? I think I might have tried this macro before and did'nt understand how to get it to run.:doh:

'===================== excel part ============'

Dim xlApp As Excel.Application

Error:

"User-defined type not defined"