autocad

How to use ArrayRectangular

This code will draw a rectangle with holes in an array. It will then save the file as a cnc file with a job number, description, and time stamp. All of the parameter can be customized with excel inputs.

First, paste the following code into an excel module. In this case I put in Module1 of as shown by red arrow below. pushing alt + f11 will bring up the visual basic editor. To switch back to excel push alt + f11 again.

Option Explicit
Dim acadApp As Object
Dim acadDoc As Object

Sub getAutoCADreferenceLib()
    On Error Resume Next
    If Len(ThisWorkbook.VBProject.Name) Then
    End If
    If Err.Number Then
        MsgBox "To grab the corrcect AutoCAD ref Lib, This app needs access to VBA Project, please tick -" & vbCr & _
            "Options, Trust Center, Trust Center Settings, Macro settings, Trust Access to VBA Project" & vbCr & vbCr & _
            "Then close workbook and try again"
        End
    End If

    Dim FilePath1 As String
    Dim FilePath2 As String
    Dim FilePath3 As String
    
    Dim ref As Variant
    For Each ref In ThisWorkbook.VBProject.References
        If ref.Name = "AutoCAD" Then
            ThisWorkbook.VBProject.References.Remove ref
        End If
    Next ref
    
    On Error Resume Next
    FilePath1 = Dir("C:\Program Files\Autodesk\AutoCAD 2017\")
    FilePath2 = Dir("C:\Program Files\Autodesk\AutoCAD 2018\")
    FilePath3 = Dir("C:\Program Files\Autodesk\AutoCAD 2019\")
    On Error GoTo 0

    If FilePath1 <> "" Then
        ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\Autodesk Shared\acax21enu.tlb")
    ElseIf FilePath2 <> "" Then
        ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\Autodesk Shared\acax22enu.tlb")
    ElseIf FilePath3 <> "" Then
        ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\Autodesk Shared\acax23enu.tlb")
    Else
        MsgBox "Error loading AutoCAD refrence library"
    End If


End Sub


Sub openautocad()


    'Check if AutoCAD application is open. If it is not opened create a new instance and make it visible.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    acadApp.Visible = True
    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
    acadApp.WindowState = acMax
   

    'If there is no active drawing create a new one.
    On Error Resume Next
    Set acadDoc = acadApp.Documents.Add
    If Err.Number <> 0 Then
        MsgBox "Could not get the AutoCAD application.  Restart Autocad and try again"
        End
    End If
    On Error GoTo 0
    
    acadDoc.ActiveSpace = acModelSpace
    
End Sub

Sub drawPrimary()
    Dim intSnapSetting As Integer
    Dim DT As String
    Dim filepath As String
    Dim strAppCap As String

    Call openautocad
    
    intSnapSetting = acadDoc.GetVariable("OSMODE")
    acadDoc.SetVariable "OSMODE", 0    'Sets the Object Snap mode to none

    'draw lines
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double

    startPoint(0) = 0: startPoint(1) = 0
    endPoint(0) = Range("PrimaryWidth"): endPoint(1) = 0
    Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
    
    startPoint(0) = Range("PrimaryWidth"): startPoint(1) = 0
    endPoint(0) = Range("PrimaryWidth"): endPoint(1) = Range("PrimaryLength")
    Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
    
    startPoint(0) = Range("PrimaryWidth"): startPoint(1) = Range("PrimaryLength")
    endPoint(0) = 0: endPoint(1) = Range("PrimaryLength")
    Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
    
    startPoint(0) = 0: startPoint(1) = Range("PrimaryLength")
    endPoint(0) = 0: endPoint(1) = 0
    Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
    
    
    Dim circleObj As AcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double

    centerPoint(0) = Range("PrimaryWidth") - 13
    centerPoint(1) = 50
    radius = 4.5
   
    ' Create the Circle object in model space
    Set circleObj = acadDoc.ModelSpace.AddCircle(centerPoint, radius)
      
    ' Define the rectangular array
    Dim numberOfRows As Long
    Dim numberOfColumns As Long
    Dim numberOfLevels As Long
    Dim distanceBwtnRows As Double
    Dim distanceBwtnColumns As Double
    Dim distanceBwtnLevels As Double
    numberOfRows = Range("PrimaryHoleQty")
    numberOfColumns = 1
    numberOfLevels = 1
    distanceBwtnRows = Range("PrimaryPitch")
    distanceBwtnColumns = 0
    distanceBwtnLevels = 0

    ' Create the array of objects
    Dim retObj As Variant
    retObj = circleObj.ArrayRectangular _
        (numberOfRows, numberOfColumns, numberOfLevels, _
        distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)

    acadApp.Update
    acadApp.ZoomExtents

    acadDoc.SetVariable "OSMODE", intSnapSetting   'return the snap setting that user had
    
    DT = Format(CStr(Now), "mm-dd_hh-mm-ss")
    filepath = ThisWorkbook.Path
        
    acadDoc.SaveAs filepath & "\" & Range("job_number") & "_" & "DXF" & "_" & DT, ac2000_dxf

End Sub

create 5 named cells as following. Put values or formulas in each of the named cells. pushing ctrl + F3 will bring up the name manager

you can also enter the name by clicking on the cell then going to the upper left box and typing the name in the Name Box circled in red below

Next add a button to the worksheet. see the video below to add a button to the worksheet and add a macro to the button. If the developer tab is not visible then add it in the excel options.

All done! Now just push the button AutoCAD will auto open and draw the objects.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s