Consulting

Results 1 to 16 of 16

Thread: Solved: Another AutoCad to Excel Question

  1. #1
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location

    Solved: Another AutoCad to Excel Question

    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.

  2. #2
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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

  3. #3
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Quote Originally Posted by KennyJ
    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'~

  4. #4
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location
    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.

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

    Dim xlApp As Excel.Application

    Error:

    "User-defined type not defined"
    Last edited by KennyJ; 06-19-2008 at 06:01 PM.

  5. #5
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Quote Originally Posted by KennyJ
    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.

    '===================== 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'~

  6. #6
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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'~

  7. #7
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    It ran fine for me after I added the reference to excel.

  8. #8
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location
    Quote Originally Posted by Fatty
     
    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.
    Last edited by KennyJ; 06-20-2008 at 05:59 AM.

  9. #9
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    What the line of code is shows up in red?

    ~'J'~

  10. #10
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location
    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.

  11. #11
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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'~

  12. #12
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location
    I attached an example of our Bom to my original post. That is everything minus the drawing and block.

  13. #13
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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.

  14. #14
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Quote Originally Posted by KennyJ
    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'~

  15. #15
    VBAX Regular
    Joined
    May 2008
    Posts
    26
    Location
    Quote Originally Posted by Tommy
    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!

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

  16. #16

    send me also that running code

    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...



    Quote Originally Posted by KennyJ
    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.

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

    Dim xlApp As Excel.Application

    Error:

    "User-defined type not defined"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •