Draw Shapes With Dimensions in Autocad
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
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 modified: September 29, 2021
Source: https://myengineeringworld.net/2019/03/dimensions-autocad-vba-excel.html
0 Response to "Draw Shapes With Dimensions in Autocad"
Post a Comment