+ Reply to Thread
Page 1 of 13 1 2 3 11 ... LastLast
Results 1 to 10 of 126
  1. #1
    Senior Member
    Using
    AutoCAD 2011
    Join Date
    Apr 2007
    Posts
    209

    Default Dimension values to Excel

    Registered forum members do not see this ad.

    Hi guys!
    Im stuck with this boring routine of reading dimension values and typing them in Excel columns for furtegr calculations.
    My dimenison are alinged in one horizontal line (see picture; blue line represents how would values had to be arranged in Excel).
    Is there anyway I could select all the dimesnions at once and copy the values in Excel column?
    You can see the picture attach of what I had in mind. Is something like this possible?
    Maybe another insanly/impossible great thing would be, selecting hatch and coping its area value to excel.
    Anyway, if anything of this is possible I would appricate it

  2. #2
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Quote Originally Posted by Butch View Post
    Hi guys!
    Im stuck with this boring routine of reading dimension values and typing them in Excel columns for furtegr calculations.
    My dimenison are alinged in one horizontal line (see picture; blue line represents how would values had to be arranged in Excel).
    Is there anyway I could select all the dimesnions at once and copy the values in Excel column?
    You can see the picture attach of what I had in mind. Is something like this possible?
    Maybe another insanly/impossible great thing would be, selecting hatch and coping its area value to excel.
    Anyway, if anything of this is possible I would appricate it
    I have similar one on what you need on VBA
    Just change file name
    Code:
    Option Explicit
    
    Sub SortDims()
    
        Dim oSset As AcadSelectionSet
        Dim oEnt As AcadEntity
        Dim oDim As AcadDimension
        Dim oDimAln As AcadDimAligned
        Dim oDimRot As AcadDimRotated
        Dim eCnt As Integer
        Dim iCnt As Integer
        Dim rCnt As Integer
        Dim iNdx As Integer
        Dim insPnt() As Double
        Dim fcode(0) As Integer
        Dim fdata(0) As Variant
        Dim dxfCode, dxfdata
    
        fcode(0) = 0: fdata(0) = "DIMENSION"
        dxfCode = fcode
        dxfdata = fdata
        Set oSset = ThisDrawing.PickfirstSelectionSet
        oSset.Clear
        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 oDim = oEnt
    
            insPnt = oDim.TextPosition
            SelPnt(eCnt, 0) = insPnt(0)
            SelPnt(eCnt, 1) = insPnt(1)
            SelPnt(eCnt, 2) = insPnt(2)
            If TypeOf oDim Is AcadDimAligned Then
                Set oDimRot = oEnt
                SelPnt(eCnt, 3) = oDimRot.Measurement
            ElseIf TypeOf oDim Is AcadDimRotated Then
                Set oDimRot = oEnt
                SelPnt(eCnt, 3) = oDimRot.Measurement
            End If
            eCnt = eCnt + 1
        Next oEnt
    
        ReDim sortPnt(0 To iCnt - 1, 0 To 3) As Variant
        sortPnt = ColSort(SelPnt, 1)
        Dim xlApp As Excel.Application
        Dim xlBook As Workbook
        Dim xlSheet As Worksheet
        Dim strFilePath As String
    
        strFilePath = "C:\ExtractDims.xls" '<-- must be exist
    
        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
    
        On Error GoTo 0
    
        Dim CheckOpen As Boolean
        Dim OpenCnt As Long
        Dim strFilePath_Name As String
        For OpenCnt = 1 To xlApp.Workbooks.Count
            If xlApp.Workbooks(OpenCnt).FullName = strFilePath Then
                CheckOpen = True
                strFilePath_Name = xlApp.Workbooks(OpenCnt).Name
            ElseIf CheckOpen = True Then
                CheckOpen = True
            Else
                CheckOpen = False
            End If
        Next
    
        If CheckOpen Then
            Set xlBook = xlApp.Workbooks(strFilePath_Name)
            Set xlSheet = xlBook.Worksheets(1)
        Else
            Set xlBook = xlApp.Workbooks.Open(strFilePath)
            Set xlSheet = xlBook.Worksheets(1)
        End If
        Dim irow As Long
        irow = 1
        
        With xlSheet
            .Range("A:A").NumberFormat = "0.00#"
            For iNdx = 0 To UBound(sortPnt, 1)
                .Cells(irow, 1) = CStr(sortPnt(iNdx, 3))
                irow = irow + 1
            Next iNdx
    
        End With
    
    End Sub
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    ' written by Fatty T.O.H. (c)2006 * all rights removed              '
    ' SourceArr - two dimensional array                                 '
    ' iPos - physical position of item in the sublist (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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  3. #3
    Senior Member
    Using
    AutoCAD 2011
    Join Date
    Apr 2007
    Posts
    209

    Default

    Fixo, what the hell is that?
    How do I activate it, and how to use it?

  4. #4
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Quote Originally Posted by Butch View Post
    Fixo, what the hell is that?
    How do I activate it, and how to use it?
    1 Copy code and paste it into Notepad
    2 Save as .bas file say "modDimToExcel.bas"in the folder you need
    3 Open Acad
    4 Press Alt+F11
    VBA editor window will be appears
    5 Click File->Import and select saved file "modDimToExcel.bas"
    6 Then go to Run->Run macro
    7 Go to Acad window and select dimensions by window
    or with another method
    Excel file will be appears
    8 Save it manually
    Amen
    Or do you want to do it with Lisp?

    PS This will not work in 2010 version

    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  5. #5
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    The same thing on Lisp

    Code:
    (defun C:dx (/ *error* abks aexc asht col data dim_data elist en i row row_data ss tmp xbks xcel xshs)
    
    (vl-load-com)
      
    (defun *error*	(msg)
      (if
        (vl-position
          msg
          '("console break"
    	"Function cancelled"
    	"quit / exit abort"
    	)
          )
         (princ "Error!")
         (princ msg)
         )
    
      )
    (if (setq ss (ssget (list (cons 0 "dimension"))))
    
      (progn
        (setq i -1)
        (repeat (sslength ss)
          (setq en	  (ssname ss (setq i (1+ i)))
    	    elist (entget en)
    	    tmp	  (cons (cdr (assoc 11 elist)) (cdr (assoc 42 elist)))
    	    data  (cons tmp data))
          )
    
        (setq dim_data (vl-sort data
    			    (function (lambda (e1 e2) (< (caar e1) (caar e2))))))
        (alert "Close Excel File Only")
        (setq aexc (vlax-get-or-create-object "Excel.Application")
    	  xbks (vlax-get-property aexc "Workbooks")
    	  abks (vlax-invoke-method xbks "Add")
    	  xshs (vlax-get-property abks "Sheets")
    	  asht (vlax-get-property xshs "Item" 1)
    	  xcel (vlax-get-property asht "Cells")
    	  )
        (vla-put-visible aexc :vlax-true)
        (setq row 0
    	  col 1)
    
    
        (repeat (length dim_data)
          (setq row_data (car dim_data))
          (setq row (1+ row))
          (vlax-put-property
    	xcel
    	"Item"
    	row
    	col
    	(vl-princ-to-string (cdr row_data))
    	)
          (setq dim_data (cdr dim_data))
          )
    
        (vlax-invoke-method
          abks
          'SaveAs
          "C:\\ImportDims.xls"
          -4143
          nil
          nil
          :vlax-false
          :vlax-false
          1
          2
          )
    
        (vlax-release-object xcel)
        (vlax-release-object asht)
        (vlax-release-object xshs)
        (vlax-release-object abks)
        (vlax-release-object xbks)
        (vlax-release-object aexc)
        (setq aexc nil)
        (gc)
        (gc)
        )
      (*error* nil)
      )
      (princ)
      )
    (prompt "\n\t\t>>>\tType DX to execute\t<<<\n")
      (princ)
    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  6. #6
    Senior Member
    Using
    AutoCAD 2011
    Join Date
    Apr 2007
    Posts
    209

    Default

    OK!
    Ill give it a run and will get back to you :-)
    Thanx in advance :-)

  7. #7
    Senior Member
    Using
    AutoCAD 2011
    Join Date
    Apr 2007
    Posts
    209

    Default

    Fixo its working, but theres a little problem.
    eg. the values in acad says 3,14m, when copied to excel it says 313.992
    Its a little extra work in Excel no problem, but can the values be the same in Acad and in Excel?
    Thanx :-)

  8. #8
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Quote Originally Posted by Butch View Post
    Fixo its working, but theres a little problem.
    eg. the values in acad says 3,14m, when copied to excel it says 313.992
    Its a little extra work in Excel no problem, but can the values be the same in Acad and in Excel?
    Thanx :-)
    Can you appload this drawing here?

    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  9. #9
    Senior Member
    Using
    AutoCAD 2011
    Join Date
    Apr 2007
    Posts
    209

    Default

    I saved as 2004 and 2007 .dwg file

    p.s. I used the .lsp file
    Attached Files

  10. #10
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by Butch View Post
    I saved as 2004 and 2007 .dwg file

    p.s. I used the .lsp file
    It's strange
    This lisp works good on my end
    I have Excel2003 on my machine installed
    See attachment
    Check Excel file - perhaps there are
    some formulas into the cells was embedded
    Another thought
    Try to change this line:
    (vl-princ-to-string (cdr row_data))
    on:
    (rtos (cdr row_data) 2 2)

    ~'J'~
    Attached Images
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Similar Threads

  1. Manipulating dimension values
    By silverfish in forum AutoLISP, Visual LISP & DCL
    Replies: 25
    Last Post: 20th Aug 2012, 11:32 am
  2. saving values to excel and back
    By comcu in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 29th Apr 2009, 09:51 pm
  3. Can I insert values of text into Excel table
    By todorb2000 in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 6th Jan 2009, 02:18 pm
  4. help!!! export autocad values in excel
    By disease34 in forum AutoCAD Drawing Management & Output
    Replies: 0
    Last Post: 7th Aug 2006, 03:43 pm
  5. AutoDraw within AutoCAD from variables/values from Excel
    By Jedidia in forum AutoCAD General
    Replies: 2
    Last Post: 24th Jun 2005, 02:12 pm

Bookmarks

Posting Permissions

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