Introduction
The previous days I worked on a hydraulic project. I had to design some pipelines in an AutoCAD 3D drawing. In the particular case, I had the pipeline coordinates and pipe sizes in an Excel workbook, so I thought that I should write a VBA code to automate this procedure. I remembered that some months ago, I published a VBA code for drawing 2D polylines in AutoCAD using data from Excel, so I started thinking of a way to expand this solution into three dimensions.
The manual way for drawing a 3D “solid” polyline, which looks like a circular pipeline in AutoCAD, involves the SWEEP command (see the video below), a 3D polyline representing the pipeline path, a circle the radius of which corresponds to the pipe radius. Unfortunately, VBA doesn’t have a SWEEP command/method, making the procedure a little bit difficult. However, it has a similar method called AddExtrudedSolidAlongPath. This method creates an extruded solid given the profile and an extrusion path. The new solid is extruded from the current location of the region using the translation of the path to the region’s Centroid. From the AutoCAD VBA help, we get its structure:
RetVal = Object.AddExtrudedSolidAlongPath(Profile, Path)
Where:
RetVal: 3DSolid object – the extruded 3DSolid object.
Object: ModelSpace Collection, PaperSpace Collection, Block – the objects this method applies to.
Profile object: input-only – the Region object only.
Path object: input-only – the Polyline, Circle, Ellipse, Spline, or Arc object only.
Remarks: You can extrude only 2D planar regions. The path should not lie on the same plane as the profile, nor should it have areas of high curvature.
Although the available path objects do not include the 3D polyline, we can use this object, but taking into account that both Profile and Path objects must not lie on the same plane. We can overcome this limitation with a simple trick: we rotate the Profile object! So, in this particular case, we rotate the circle 45 degrees over the y axis for the circle plane to be different than the 3D polyline plane(s). Moreover, we apply the Move method to move the 3D “solid” polyline back to its original position (since the AddExtrudedSolidAlongPath method will start drawing the 3D “solid” polyline at profile’s coordinates – usually at (0,0,0)).
VBA code to draw a 3D polyline
Here is the VBA code for drawing the 3D “solid” polyline. If the user doesn’t enter a radius value (which determines the pipe radius), the code will draw only the 3D polyline.
Option Explicit
Sub Draw3DPolyline()
'--------------------------------------------------------------------------------------------------
'Draws a 3D polyline in AutoCAD using X, Y, and Z coordinates from the sheet Coordinates.
'If the user enter a radius value the code transforms the 3D polyline to a pipe-like solid, using
'the AddExtrudedSolidAlongPath method. In this way, you can draw a pipeline directly from Excel!
'The code uses late binding, so no reference to external AutoCAD (type) library is required.
'It goes without saying that AutoCAD must be installed at your computer before running this code.
'Written By: Christos Samaras
'Date: 27/11/2013
'Last Updated: 12/03/2014
'E-mail: [email protected]
'Site: https://myengineeringworld.net
'--------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim acadApp As Object
Dim acadDoc As Object
Dim LastRow As Long
Dim acad3DPol As Object
Dim dblCoordinates() As Double
Dim i As Long
Dim j As Long
Dim k As Long
Dim objCircle(0 To 0) As Object
Dim CircleCenter(0 To 2) As Double
Dim CircleRadius As Double
Dim RotPoint1(2) As Double
Dim RotPoint2(2) As Double
Dim Regions As Variant
Dim objSolidPol As Object
Dim FinalPosition(0 To 2) As Double
'Activate the coordinates sheet and find the last row.
With Sheets("Coordinates")
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'Check if there are at least two points.
If LastRow < 3 Then
MsgBox "There are not enough points to draw the 3D polyline!", vbCritical, "Points Error"
Exit Sub
End If
'Check if AutoCAD application is open. If not, 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 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
'Check if there is an active drawing. If no active drawing is found, create a new one.
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
End If
On Error GoTo 0
'Get the one dimensional array size (= 3 * number of coordinates (x,y,z)).
ReDim dblCoordinates(1 To 3 * (LastRow - 1))
'Pass the coordinates to the one dimensional array.
k = 1
For i = 2 To LastRow
For j = 1 To 3
dblCoordinates(k) = Sheets("Coordinates").Cells(i, j)
k = k + 1
Next j
Next i
'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
'Draw the 3D polyline at model space.
Set acad3DPol = acadDoc.ModelSpace.Add3DPoly(dblCoordinates)
'Leave the 3D polyline open (the last point is not connected to the first one).
'Set the next line to True if you need to close the polyline.
acad3DPol.Closed = False
acad3DPol.Update
'Get the circle radius.
CircleRadius = Sheets("Coordinates").Range("E1").Value
If CircleRadius > 0 Then
'Set the circle center at the (0,0,0) point.
CircleCenter(0) = 0: CircleCenter(1) = 0: CircleCenter(2) = 0
'Draw the circle.
Set objCircle(0) = acadDoc.ModelSpace.AddCircle(CircleCenter, CircleRadius)
'Initialize the rotational axis.
RotPoint1(0) = 0: RotPoint1(1) = 0: RotPoint1(2) = 0
RotPoint2(0) = 0: RotPoint2(1) = 10: RotPoint2(2) = 0
'Rotate the circle in order to avoid errors with AddExtrudedSolidAlongPath method.
objCircle(0).Rotate3D RotPoint1, RotPoint2, 0.785398163 '45 degrees
'Create a region from the circle.
Regions = acadDoc.ModelSpace.AddRegion(objCircle)
'Create the "solid polyline".
Set objSolidPol = acadDoc.ModelSpace.AddExtrudedSolidAlongPath(Regions(0), acad3DPol)
'Set the position where the solid should be transferred after its design (its original position).
With Sheets("Coordinates")
FinalPosition(0) = .Range("A2").Value
FinalPosition(1) = .Range("B2").Value
FinalPosition(2) = .Range("C2").Value
End With
'Move the solid to its final position.
objSolidPol.Move CircleCenter, FinalPosition
'Delete the circle.
objCircle(0).Delete
'Delete the region.
Regions(0).Delete
'If the "solid polyline" was created successfully delete the initial polyline.
If Err.Number = 0 Then
acad3DPol.Delete
End If
End If
'Zooming in to the drawing area.
acadApp.ZoomExtents
'Release the objects.
Set objCircle(0) = Nothing
Set objSolidPol = Nothing
Set acad3DPol = Nothing
Set acadDoc = Nothing
Set acadApp = Nothing
'Inform the user that the 3D polyline was created.
MsgBox "The 3D polyline was successfully created in AutoCAD!", vbInformation, "Finished"
End SubThe above code was successfully tested in Excel and AutoCAD 2013 (both 32bit). However, it should work in other Excel/AutoCAD versions.
Demonstration video
The short video below demonstrates both the manual (using SWEEP command) and the automatic way (Excel VBA) to create a 3D solid polyline in AutoCAD.
Downloads
The file can be opened with Excel 2007 or newer. Please enable macros before using it.
Read also
Draw A Polyline In AutoCAD Using Excel VBA
Drawing Circles In AutoCAD Using Excel & VBA
Add Text In AutoCAD Using Excel & VBA
Add Dimensions In AutoCAD Using Excel & VBA
Drawing Points In AutoCAD Using Excel & VBA
