Library bindings
For library binding to ActiveX objects from AutoCAD (or equivalent software), we can follow these posts on StackOverflow and theSwamp.org, that gives us the references for AutoCAD application. For every software, and for each every version, there will be a different GUI code, so take care.
‘[HKEY_CLASSES_ROOT\AutoCAD.Application\CurVer]
‘@=”AutoCAD.Application.21″
‘
‘[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AutoCAD.Application.21]
‘
‘[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AutoCAD.Application.21\CLSID]
‘@=”{0D327DA6-B4DF-4842-B833-2CFF84F0948F}”
‘
‘[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AutoCAD.Application]
‘@=”AutoCAD Application”
‘
‘[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AutoCAD.Application\CLSID]
‘@=”{0D327DA6-B4DF-4842-B833-2CFF84F0948F}”
‘
‘[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AutoCAD.Application\CurVer]
‘@=”AutoCAD.Application.21″
Another ‘better’ option is to go with ‘Late binding’ (instead of ‘Early binding’ that needs the references to be set in the VBA project). It’s no so clear and get developers far away from IntellySense, but knowing the objects, methods and properties, you can manage. It has the tremendous advantage that there is no need for the software version user has installed on his/her computer to be the same as in the developer’s (of course, they must have the same CAD software…).
These are late binding declarations for the two common objects (oCADApp and oCADDoc).
Private oCadApp As Object 'AutoCAD.AutoCADApplication or BricscadApp.AcadApplication
Private oCadDoc As Object 'AutoCAD.AutoCADDrawing or BricscadApp.AcadDocument
Opening a drawing in CAD. Linking to objects
To draw inside CAD application through VBA we need to link the CAD application instante and the CAD drawing document, in order to do it programmatically use following code:
Private oCadApp As Object 'AutoCAD.AutoCADApplication or BricscadApp.AcadApplication
Private oCadDoc As Object 'AutoCAD.AutoCADDrawing or BricscadApp.AcadDocument
Private Function fCADOpen(ByRef oCadApp As Object, _
ByRef oCadDoc As Object, _
Optional ByRef strFullPath_File As String = vbNullString) As Boolean
' Get CAD instance and CAD drawing document
'Check if AutoCAD application is open. If not, create a new instance and make it visible.
On Error Resume Next
Set oCadApp = GetObject(, "AutoCAD.Application") '(, "BricscadApp.Application") '= New BricscadApp.AcadApplication in Early binding
If oCadApp Is Nothing Then
' or also:
'If Err.Description > vbNullString Then
' Err.Clear
Set oCadApp = CreateObject("AutoCAD.Application") '("BricscadApp.Application")
oCadApp.Visible = True
End If
'Check if there is an AutoCAD object.
If oCadApp Is Nothing Then
MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
fCADOpen = False: GoTo ExitProc
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
'strFullPath_File = VBA.Environ("UserProfile") & "\Documents\Doc.dxf"
'Set oCadDoc = oCadApp.Documents.Open (strFullPath_File)
Set oCadDoc = oCadApp.ActiveDocument
If oCadDoc Is Nothing Then
Set oCadDoc = oCadApp.Documents.Add
End If
On Error GoTo 0
If oCadDoc Is Nothing Then fCADOpen = False: GoTo ExitProc
'Check if the active space is paper space and change it to model space.
With oCadDoc
If .ActiveSpace = 0 Then '0 = acPaperSpace in early binding
.ActiveSpace = 1 '1 = acModelSpace in early binding
End If
End With
ExitProc:
On Error GoTo 0
Exit Function
End Function
Remember that the CAD object is open, to close it programmatically, use following code:
Public Function fCloseCAD(Optional ByVal strFullPathFile_CAD As String = vbNullString)
If strFullPathFile_CAD = vbNullString Then
strFullPathFile_CAD = VBA.Environ("UserProfile") & "\Documents\Unknown.dwg"
End If
oCadDoc.SaveAs strFullPathFile_CAD
oCadApp.Documents.Close
oCadApp.Quit
Set oCadDoc = Nothing
Set oCadApp = Nothing
End Function
Drawing in CAD data from Excel
If we want to draw some entities, we can use something like these codes, derived from theSwamp.org, and Christos Samaras’s (My Engineering World) posts 1 (to draw a 2D polyline) and 2 (to draw a 3D polyline with a extruded section). Modify to your convenience.
Public Sub DrawText()
Dim strFullPath_File As String
Dim Height As Double
Dim P(0 To 2) As Double
Dim oCADText As Object 'AutoCAD.AutoCADApplication.AcadText or BricscadApp.AcadText
Dim TxtStr As String
Height = 1
P(0) = 1: P(1) = 1: P(2) = 0
TxtStr = Cells(1, 1)
Set oCADText = oCadDoc.ModelSpace.AddText(TxtStr, P, Height)
Set oCADText = Nothing
End Sub
Public Sub sDrawPolyline()
'Draws a polyline in AutoCAD using X and Y coordinates from sheet Coordinates.
'Declaring the necessary variables.
Dim oCadPol As Object 'AcadLWPolyline
Dim dblCoordinates() As Double
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim wsData As Excel.Worksheet
Dim rgData As Excel.Range
' Get data
'Set rgData = Application.InputBox(Prompt:="Select range of points", _
Title:="Select data", _
Default:=Selection.Address(True, True), _
Type:=8)
Set wsData = rgData.Parent 'ActiveSheet
With wsData
.Activate
'Find the last row.
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Check if there are at least two points.
If LastRow < 3 Then
MsgBox "There not enough points to draw the polyline!", vbCritical, "Points Error"
Exit Sub
End If
'Get the array size.
ReDim dblCoordinates(2 * (LastRow - 1) - 1)
'Pass the coordinates to array.
k = 0
For i = 2 To LastRow
For j = 1 To 2
dblCoordinates(k) = .Cells(i, j)
k = k + 1
Next j
Next i
End With
' Get CAD app and Doc
Call fCADOpen(oCadApp, oCadDoc)
'Draw the polyline either at model space or at paper space.
'If oCadDoc.ActiveSpace = acModelSpace Then
Set oCadPol = oCadDoc.ModelSpace.AddLightWeightPolyline(dblCoordinates)
'Else
' Set oCadPol = oCadDoc.PaperSpace.AddLightWeightPolyline(dblCoordinates)
'End If
'Leave the polyline open (the last point is not connected with the first point).
'Set the next line to true if you need to connect the last point with the first one.
oCadPol.Closed = False
oCadPol.Update
'Zooming in to the drawing area.
oCadApp.ZoomExtents
'Inform the user that the polyline was created.
MsgBox "The polyline was successfully created!", vbInformation, "Finished"
End Sub
Public Sub sDraw3DPolyline()
' 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!
' 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 not include the 3D polyline, we can use this object,
' but taking into account the fact 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 the particular case, we rotate the circle 45 degrees over the y axis,
' in order the circle plane to be different than the 3D polyline plane(s).
' Moreover, we apply the Move method in order 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)).
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Can also be achieved with the SWEEP command/method over an SCR phrase
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Declaring the necessary variables.
Dim oCad3DPol As Object 'BricscadApp.Pol3D
Dim oCircle(0 To 0) As Object 'BricscadApp.Circle
Dim oSolidPol As Object 'BricscadApp.Solid3D
Dim LastRow As Long
Dim dblCoordinates() As Double
Dim i As Long
Dim j As Long
Dim k As Long
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 FinalPosition(0 To 2) As Double
Dim lgRetVal As Long
Dim wsData As Excel.Worksheet
Dim rgRadius As Excel.Range
Dim rgCoordinates As Excel.Range
' Get coordinates data
'Set rgCoordinates = Application.InputBox(Prompt:="Select range of points", _
Title:="Select data", _
Default:=Selection.Address(True, True), _
Type:=8)
Set wsData = rgCoordinates.Parent 'ActiveSheet
With wsData
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Check if there are at least two points.
If LastRow 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 oCircle(0) = oCadDoc.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.
oCircle(0).Rotate3D RotPoint1, RotPoint2, 0.785398163 '45 degrees
' Create a region from the circle.
Regions = oCadDoc.ModelSpace.AddRegion(oCircle)
' Create the "solid polyline".
Set oSolidPol = oCadDoc.ModelSpace.AddExtrudedSolidAlongPath(Regions(0), oCad3DPol)
' Set the position where the solid should be transfered 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.
oSolidPol.Move CircleCenter, FinalPosition
' Delete the circle.
oCircle(0).Delete
' Delete the region.
Regions(0).Delete
' If the "solid polyline" was created successfully delete the initial polyline.
If Err.Number = 0 Then
oCad3DPol.Delete
End If
End If
' Zooming in to the drawing area.
oCadApp.ZoomExtents
' Release the objects.
Set oCircle(0) = Nothing
Set oSolidPol = Nothing
Set oCad3DPol = Nothing
' Inform the user that the 3D polyline was created.
lgRetVal = MsgBox("The 3D polyline was successfully created in AutoCAD!", vbInformation, "Finished")
End Sub
[/sourcecode]