May 22, 2021
Following a comment on my YouTube channel requesting a tutorial on how to draw a circular column section in AutoCAD from Excel, I decided to write and share the below program.
VBA simple code to draw circular column section in AutoCAD using excel VBA.
Option Explicit Const PI = 3.14159265358979 Sub DrawRectange() Dim AutocadApp As Object Dim Cover As Integer Dim Column As Object Dim ActDoc As Object Dim CirObj As Object Dim Nbrbar As Integer Dim FilledCir As Object Dim Marray(0) As Object Dim OffsetRect As Variant Dim rebarsectionPos As Variant Dim Stirrup As Object Dim ColumnCenter As Variant Dim ColumnDiameter As Double Dim Barsize As Double Dim i As Integer '****** Launch Autocad application**** On Error Resume Next Set AutocadApp = GetObject(, "Autocad.application") On Error GoTo 0 If AutocadApp Is Nothing Then Set AutocadApp = CreateObject("Autocad.application") AutocadApp.Visible = True End If ''****Read Input**** ColumnDiameter = ActiveSheet.Range("f5") Cover = ActiveSheet.Range("f6") Nbrbar = ActiveSheet.Range("f8") Barsize = ActiveSheet.Range("f9") ''****Draw rectangle**** On Error Resume Next Set ActDoc = AutocadApp.ActiveDocument On Error GoTo 0 If ActDoc Is Nothing Then Set ActDoc = AutocadApp.Documents.Add End If On Error Resume Next ColumnCenter = ActDoc.Utility.GetPoint(, "Select the position of column.") Set Column = ActDoc.modelspace.AddCircle(ColumnCenter, ColumnDiameter / 2) OffsetRect = Column.Offset(-Cover) Set Stirrup = OffsetRect(0) Stirrup.constantwidth = 5 ''Add rebar section Dim angle As Double angle = 0 For i = 1 To Nbrbar rebarsectionPos = ActDoc.Utility.PolarPoint(ColumnCenter, angle, (ColumnDiameter / 2 - Barsize / 2 - Cover)) Set CirObj = ActDoc.modelspace.AddCircle(rebarsectionPos, Barsize / 2) CirObj.Color = acRed ''filled rebar section Set FilledCir = ActDoc.modelspace.addhatch(acHatchPatternTypePreDefined, "Solid", True) Set Marray(0) = CirObj With FilledCir .appendouterloop (Marray) .Evaluate .Color = acRed .Update End With angle = angle + (2 * PI) / Nbrbar Next i AutocadApp.ZoomExtents Set AutocadApp = Nothing Set ActDoc = Nothing Set CirObj = Nothing Set Marray(0) = Nothing Set FilledCir = Nothing End Sub
How to use this program?
Watch video tutorial HERE ON YouTube
- Version 1.0.0
- Download 20702
- File Size 22 KB
- File Count 1
- Create Date May 22, 2021
- Last Updated June 4, 2021
File | Action |
---|---|
Draw Circular column section.zip | Download |
If you believe my tools are helping you and would like to support me, please use the below button to donate.
.
thank you
Hi Maadh,
You are Welcome.