Create CAD drawing from Excel Instantly

[AlexAlex88]

Hi everybody thank you for welcoming me in,

I need to generate multiple autoCAD drawings with Excel.
I just found this beautiful video on youtube that fills my initial need.
Does anyone have similar VBA code or actually own this code that could help me tremendously to get started ?


https://www.youtube.com/watch?v=ASxf-ujfJ4o&t=18s

[SLW210]

I have moved your thread to the  .NET, ObjectARX & VBA Forum.

[SLW210]

It appears to be Excel based, you might have better luck on an Excel VBA site.

 

I got a warning about the web page they linked in the video and it seems they are not responding to questions on the YouTube site either.

[BIGAL]

Maybe start with this it was after googling one object create at a time "Line VBA excel autocad" etc.

 

There was a post a couple of days ago also about this think it was here.

 

Sub Opendwg()
 
    Dim acadApp As Object
    Dim acadDoc As Object

 '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
 
    'If there is no active drawing 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
  
    '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

 End Sub
 
Public Sub addline(x1, y1, z1, x2, y2, z2)
  
 ' Create the line in model space
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim startpoint(0 To 2) As Double
    Dim endpoint(0 To 2) As Double
    Dim lineobj As Object

    startpoint(0) = x1: startpoint(1) = y1: startpoint(2) = z1
    endpoint(0) = x2: endpoint(1) = y2: endpoint(2) = z2

    Set lineobj = acadDoc.ModelSpace.addline(startpoint, endpoint)
    acadApp.ZoomExtents
    
    End Sub
    Public Sub addcirc(x1, y1, z1, rad)
  
 ' Create the circle in model space
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim cenpoint(0 To 2) As Double
   
    Dim circobj As Object

   cenpoint(0) = x1: cenpoint(1) = y1: cenpoint(2) = z1
    Set circobj = acadDoc.ModelSpace.addcircle(cenpoint, rad)
    acadApp.ZoomExtents
    
    End Sub
    
    
    Sub addpoly(cords, col)
    
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim oPline As Object
    
' add pline to Modelspace
Set oPline = acadDoc.ModelSpace.AddLightWeightPolyline(cords)
oPline.Color = col

End Sub
   
    Sub alan1()
    
   
' This example adds a line in model space
' Define the start and end points for the line
   
    px1 = 1
    px2 = 5
    py1 = 1
    py2 = 5
    pz1 = 0
    pz2 = 0
    

Call addline(px1, py1, pz1, px2, py2, pz2)

End Sub

 Sub alan2()
 
    px1 = 1
    py1 = 1
    pz1 = 0
    Radius = 8.5
 
 Call addcirc(px1, py1, pz1, Radius)

 End Sub
 
 Sub alan3()
 'Dim coords(0 To n) As Double
 Dim coords(0 To 5) As Double
 coords(0) = -6: coords(1) = 1:
 coords(2) = 3: coords(3) = 5:
 coords(4) = 7.55: coords(5) = 6.25:
 
 col = 1
    
 Call addpoly(coords, col)

 End Sub