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

    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


    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), _

    Set wsData = rgData.Parent 'ActiveSheet
    With wsData

        '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)
    '    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

    'Zooming in to the drawing area.

    '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), _

    Set wsData = rgCoordinates.Parent 'ActiveSheet
    With wsData

        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.

        ' Delete the region.

        ' If the "solid polyline" was created successfully delete the initial polyline.
        If Err.Number = 0 Then
        End If
    End If

    ' Zooming in to the drawing area.

    ' 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

Leave a Reply

Your email address will not be published. Required fields are marked *