Add Dimensions In AutoCAD Using Excel & VBA

Share this

March 31, 2019

Add Dimensions In AutoCAD Using Excel VBA


Introduction


Almost 4.5 years have passed since the last post that I published dealing with AutoCAD and Excel cross-application development. Well, that’s quite a long time, don’t you think? Anyway, we have already learned how to draw several objects in AutoCAD from Excel (e.g. polylines, circles, and points), as well as how to add text and blocks in a drawing. But, how about dimensions? Is it possible to add dimensions in an AutoCAD drawing from Excel? Of course, it is!

The proposed solution is based on the AddDimAligned method of AutoCAD, which creates an aligned dimension to the specified document. According to AutoCAD VBA help, the structure of AddDimAligned method is the following:

RetVal = object.AddDimAligned(ExtLine1Point, ExtLine2Point, TextPosition)

RetVal: The newly created aligned dimension.
Object: Block, ModelSpace and PaperSpace. The objects this method applies to.
ExtLine1Point: Variant (three-element array of doubles). The 3D WCS coordinates specifying the first endpoint of the extension line.
ExtLine2Point: Variant (three-element array of doubles). The 3D WCS coordinates specifying the second endpoint of the extension line.
TextPosition: Variant (three-element array of doubles). The 3D WCS coordinates specifying the text position.

The sample workbook that you will find in the Downloads section below requires two main parameters: the coordinates of the starting point (ExtLine1Point) and the ending point (ExtLine2Point). The position of the displayed text (TextPosition) is automatically calculated in the middle of the two points.

 


VBA code for adding dimensions to AutoCAD from Excel


The code is actually a loop; most of the code is used to initialize the AutoCAD application object, as well as to open the sample drawing or to create a new one. Inside the code, you will find several formatting options, which you can customize according to your needs. Moreover, the dimOffset variable is used for adding an extra space between the dimension line and the object that is measured.

Option Explicit
 
Sub AddDimensions()
 
    '-----------------------------------------------------------------------------------------------------------------------------
    'The macro adds the dimensions that exist in the sheet named "Dimensions" to the opened or to a new AutoCAD drawing.
    'It uses the AutoCAD AddDimAligned method to add the dimensions.
 
    'The code uses late binding, so no reference to external AutoCAD (type) library is required.
    'It goes without saying that AutoCAD, as well as VBA in AutoCAD, must be installed at your computer before running this code.
 
    'Written By:    Christos Samaras
    'Date:          14/03/2019
    'Last Updated:  08/04/2019
    'E-mail:        [email protected]
    'Site:          https://www.myengineeringworld.net
    '-----------------------------------------------------------------------------------------------------------------------------
 
    'Declaring the necessary variables.
    Dim acadApp             As Object
    Dim acadDoc             As Object
    Dim acadDimAligned      As Object
    Dim startingPoint(2)    As Double
    Dim endingPoint(2)      As Double
    Dim textLocation(2)     As Double
    Dim dimOffset           As Double
    Dim lastRow             As Long
    Dim i                   As Long
 
    'This is the vertical distance between the objected measured and the dimension line.
    'You can adjust it according to your needs.
    dimOffset = 100
 
    'Activate the dimensions sheet and find the last row.
    With Sheets("Dimensions")
        .Activate
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
    'Check if there are coordinates for at least one dimension.
    If lastRow < 3 Then
        MsgBox "There are no coordinates in the sheet!", vbCritical, "Coordinates Error"
        Exit Sub
    End If
 
    'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
 
    'Check (again) if there is an AutoCAD object.
    If acadApp Is Nothing Then
        MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
        Exit Sub
    End If
    On Error GoTo 0
 
    'Try to open the sample drawing.
    On Error Resume Next
    Set acadDoc = acadApp.Documents.Open(ThisWorkbook.Path & "\" & "Sample Drawing.dwg")
 
    'If the sample file cannot be opened, create a new drawing.
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
    End If
    On Error GoTo 0
 
    'Check if the active space is paper space and change it to model space.
    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
    End If
 
    On Error Resume Next
    'Loop through all the rows of the sheet and add the corresponding dimensions in the drawing.
    With Sheets("Dimensions")
 
        For i = 3 To lastRow
 
            'Set the starting point.
            startingPoint(0) = .Range("A" & i).Value
            startingPoint(1) = .Range("B" & i).Value
            startingPoint(2) = .Range("C" & i).Value
 
            'Set the ending point.
            endingPoint(0) = .Range("D" & i).Value
            endingPoint(1) = .Range("E" & i).Value
            endingPoint(2) = .Range("F" & i).Value
 
            'Calculate the text location point.
            If startingPoint(1) = endingPoint(1) Then
 
                'Horizontal line.
                textLocation(0) = (startingPoint(0) + endingPoint(0)) / 2
                textLocation(1) = startingPoint(1) + dimOffset
                textLocation(2) = startingPoint(2)
 
            ElseIf startingPoint(0) = endingPoint(0) Then
 
                'Vertical line.
                textLocation(0) = startingPoint(0) + dimOffset
                textLocation(1) = (startingPoint(1) + endingPoint(1)) / 2
                textLocation(2) = startingPoint(2)
 
            Else
 
                'Any other line.
                If startingPoint(1) > endingPoint(1) Then
                    textLocation(0) = (startingPoint(0) + endingPoint(0)) / 2 + dimOffset
                    textLocation(1) = (startingPoint(1) + endingPoint(1)) / 2
                    textLocation(2) = startingPoint(2)
                Else
                    textLocation(0) = (startingPoint(0) + endingPoint(0)) / 2 - dimOffset
                    textLocation(1) = (startingPoint(1) + endingPoint(1)) / 2
                    textLocation(2) = startingPoint(2)
                End If
 
            End If
 
            'Add the dimension in the drawing.
            Set acadDimAligned = acadDoc.ModelSpace.AddDimAligned(startingPoint, endingPoint, textLocation)
 
            'Format the dimension object according to your needs.
            With acadDimAligned
                .TextHeight = 30
                .TextGap = 10               'The distance of the dimension text from the dimension line.
                .Arrowhead1Type = 5         'acArrowOblique in early binding
                .Arrowhead2Type = 5         'For the standard dimension arrow put 0 here.
                .ArrowheadSize = 20
                .ExtensionLineExtend = 10   'The amount to extend the extension line beyond the dimension line.
            End With
 
            'Reset the arrays.
            Erase startingPoint
            Erase endingPoint
            Erase textLocation
 
        Next i
 
    End With
 
    'Zoom in to the drawing area.
    acadApp.ZoomExtents
 
    'Release the objects.
    Set acadDimAligned = Nothing
    Set acadDoc = Nothing
    Set acadApp = Nothing
 
    'Inform the user about the process.
    MsgBox "The dimensions were successfully added in the drawing!", vbInformation, "Finished"
 
End Sub 

Note that if you have AutoCAD 2010 or a more recent version, you will have to download and install the VBA module, otherwise the code will fail. Just navigate to Autodesk‘s website and download the appropriate version.

 


Demonstration video


The short video below demonstrates the result of the above VBA code (10 dimensions are added in the drawing).

 


Downloads


Download

The zip file contains an Excel workbook along with a sample drawing that can be used to test the VBA code. The workbook can be opened with Excel 2007 or newer. Please enable macros before using it.

 


Read also


Send AutoCAD Commands From Excel & VBA
Drawing Points In AutoCAD Using Excel & VBA
Drawing Circles In AutoCAD Using Excel & VBA
Add Text In AutoCAD Using Excel & VBA
Send AutoCAD Commands From Excel & VBA

Page last updated: 13/06/2019

Page last modified: February 20, 2020

Christos Samaras

Hi, I am Christos, a Mechanical Engineer by profession (Ph.D.) and a Software Developer by obsession (10+ years of experience)! I founded this site back in 2011 intending to provide solutions to various engineering and programming problems.

Christos E. Samaras

  • alkhhamosi says:

    what is this command? what is language?

    (defun numeric()
    (setq scfc 111189000.0)
    (textscr)
    (princ “nMetric Scale
    =============
    (2000000) 1 : 2000000
    (1000000) 1 : 1000000
    (500000) 1 : 500000
    (250000) 1 : 250000
    (100000) 1 : 100000
    (1) Full”)
    (setq DRSC (GETREAL “nEnter Scale Number :”))
    (setq width (getreal “nEnter Format width :”))
    (setq height (getreal “nEnter Format height :”))

    (setq paper_width (*(/ drsc scfc) width))
    (setq paper_height(*(/ drsc scfc) height))
    (setq plotscale (/ scfc drsc))
    (setq FROM(GETPOINT “nPick First Corner :”))
    (setq TO (strcat “@” (rtos paper_width 2 5) “,” (rtos paper_height 2 5)))
    ;*****************autocad command
    (command “rectang” from to)
    ;********************************
    (setq paper_width(strcat “Paper Width : ” (rtos PAPER_WIDTH 2 5)))
    (setq paper_height(strcat “Paper Height : ” (rtos PAPER_HEIGHT 2 5)))
    (setq plotscale(strcat “Plot Scale : ” (rtos plotscale 2 5)))
    (textscr)
    (PRINT paper_width)
    (PRINT PAPER_HEIGHT)
    (PRINT PLOTSCALE)
    (print)
    (print “This program create & design by Barju Ristiyanto”)
    (PRINT)
    )

  • {"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
    Add Content Block
    >