VBA Macro to Create Closed Shape in AutoCAD 2021

53 views Asked by At
Sub CreateClosedShape()
    Dim Myapp As Object
    Dim myDwg As AcadDocument
    Dim autocadPath As String
    autocadPath = "C:\Program Files\Autodesk\AutoCAD 2021\acad.exe"
    
   
    'Attempt to get the running instance of AutoCAD
    On Error Resume Next
    Set Myapp = GetObject(, "Autocad.Application")
    On Error GoTo errorhandler:
    
 errorhandler:
    
    'If AutoCAD is not running, create a new instance
    If Myapp Is Nothing Then
        Set Myapp = CreateObject("Autocad.Application")
    End If
    
    ' Set the path to the AutoCAD executable
    'Myapp.Application.Path = autocadPath
    Myapp.Visible = True
    
    
Set myDwg = Myapp.ActiveDocument
   

     ' Assuming your Excel data is in Sheet1, starting from cell A1
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
        
        ' Assuming your data consists of X and Y coordinates in columns A and B
        Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' Check if there are enough points to create a closed shape
        If lastRow < 2 Then
            MsgBox "Insufficient data to create a closed shape.", vbExclamation
            Exit Sub
        End If
        
        ' Get the vertices as a list
        Dim verticesList() As Double
        ReDim verticesList(0 To lastRow * 2 - 1)
        
        Dim i As Long
        Dim j As Long
        j = -1
       
        For i = 1 To lastRow
            j = j + 1
       verticesList(j) = ws.Cells(i, 1).Value
       j = j + 1
       verticesList(j) = ws.Cells(i, 2).Value
        Next i
        
        
        ' Create a polyline to represent the closed shape
        Dim polylineObj As IAcadLWPolyline
        Set polylineObj = myDwg.ModelSpace.AddLightWeightPolyline(verticesList)
        
        Dim offsetDistance As Double
        offsetDistance1 = 0.15  ' You can change this value
        offsetDistance2 = 0.075  ' You can change this value
    
    ' Create an offset of the polyline
        Dim offsetPolylineObj1 As IAcadLWPolyline
        Dim offsetPolylineObj2 As IAcadLWPolyline
        
        Set offsetPolylineObj1 = 
          myDwg.ModelSpace.AddLightWeightPolyline(polylineObj.Offset(offsetDistance1))
        Set offsetPolylineObj2 = 
          myDwg.ModelSpace.AddLightWeightPolyline(offsetPolylineObj1.Offset(offsetDistance2))
        
        MsgBox "Closed shape created successfully!", vbInformation
    End Sub
    Set offsetPolylineObj1 = 
     myDwg.ModelSpace.AddLightWeightPolyline(polylineObj.Offset(offsetDistance1))
        Set offsetPolylineObj2 = 
     myDwg.ModelSpace.AddLightWeightPolyline(offsetPolylineObj1.Offset(offsetDistance2))

i getting error for above two line like invalid argument runtime error 5

1

There are 1 answers

0
Surrogate On

AddPolyline Method must have argument as Variant Type (array of doubles)!

polylineObj.Offset(offsetDistance1)

Please read more about Offset Method.
This code works at my side

    Sub CreateClosedShape()
    Dim Myapp As Object
    Dim myDwg As AcadDocument
 
    'Attempt to get the running instance of AutoCAD
    On Error Resume Next
    Set Myapp = GetObject(, "Autocad.Application")
    On Error GoTo errorhandler:
    
errorhandler:
    
    'If AutoCAD is not running, create a new instance
    If Myapp Is Nothing Then
        Set Myapp = CreateObject("Autocad.Application")
    End If
  
    ' Set the path to the AutoCAD executable
    'Myapp.Application.Path = autocadPath
    Myapp.Visible = True
    
Set myDwg = Myapp.ActiveDocument
   
myDwg.Regen acAllViewports
     ' Assuming your Excel data is in Sheet1, starting from cell A1
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
        
        ' Assuming your data consists of X and Y coordinates in columns A and B
        Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' Check if there are enough points to create a closed shape
        If lastRow < 2 Then
            MsgBox "Insufficient data to create a closed shape.", vbExclamation
            Exit Sub
        End If
        
        ' Get the vertices as a list
        Dim verticesList() As Double
        ReDim verticesList(0 To lastRow * 2 - 1)
        Dim i As Long
        Dim j As Long
        j = -1
        For i = 1 To lastRow
            j = j + 1
       verticesList(j) = ws.Cells(i, 1).Value
       j = j + 1
       verticesList(j) = ws.Cells(i, 2).Value
        Next i
        
        ' Create a polyline to represent the closed shape
        Dim polylineObj As IAcadLWPolyline
        Set polylineObj = myDwg.ModelSpace.AddLightWeightPolyline(verticesList)
        
        myDwg.Regen acAllViewports
        
        Dim offsetObj1 As Variant, offsetObj2 As Variant
        offsetObj1 = polylineObj.Offset(0.25)
        myDwg.Regen acAllViewports
        offsetObj2 = polylineObj.Offset(-0.125)         
        myDwg.Regen acAllViewports
        
        MsgBox "Closed shape created successfully!", vbInformation
    End Sub