Thread: Manipulating Shapes

I didn't know AutoCAD supported VBA ... huh.

One advantage of using Visio is that it has a macro recorder. I've never automated Visio (and never used AutoCAD), and so can't make an informed recommendation, but I suspect Visio would be easier if the problem is more drawing-oriented, and AutoCAD if the problem is more CAD-oriented.

As of Release 14 AutoCAD supports use of VBA and there are code snippets available via a web search as well as tutorials. However, though VBA is supported, they are moving toward support of .NET.

I agree with Marcol - skip Excel and work directly within AutoCAD.

Strictly speaking, Visio doesn't support layers like CAD, but (sort of) simulates layers by allowing a background sheet for common page elements and each sheet is, like Excel, independent from other sheets.

AutoCAD VBA Support

Visio doesn't support layers like CAD

Visio does support named layers, and independent control (e.g., visibility) for each.

Visio does support named layers, and independent control (e.g., visibility) for each.

I may have misspoken on that point, but the PC I'm on now doesn't have Visio and I don't typically need layers. Does the layer features exist in pre-2007 versions?

I only have 2007 now, P, but recollect it existed at least back to 2002.

Layers are not inherent in Visio

Code:

    With Application.ActiveWindow.Page
        .Layers.Add ("Marcol")
        .Layers.Add ("Palmetto")

        .Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = """0"""
        .Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = """1"""
    End With

Sorry shg I was comparing Visio to AutoCAD which has infinitely more control

I have probably missed the potential of Visio layers because of this.

I was comparing Visio to AutoCAD which has infinitely more control

I don't doubt that. Visio is an office (small o) drawing program. I know some AutoCAD wizards, and they do amazing stuff in 3D.

Hi Breizh29
I use Drawing Exchange Format (DXF) file then open and reference the file in AutoCad .
with dxf you can set the layers and shapes lines text ect....

Hi Breizh29

This might be worth a try.

The resulting drawing is very basic but it should be enough to demonstrate the principle.

1/. Open AutoCAD

2/. Press Alt + f11 to open the visual basic editor
Or Tools > Macros > Visual Basic Editor

3/. In the Editor
Insert > Module

4/. Copy and paste all of the code below into this empty module.

5/- Change this Sub to suit the full path name to where you have stored the Sample Excel File attached.

Code:

Sub DrawCables()
    DrawCablesFromExcelFile "C:\Users\Alistair\AutoCAD\CableTrays.XLS", "Sheet1"
End Sub

5/. Close the editor.

6/. In AutoCAD
Press Alt + f8 to open the Macro Dialogue Box
Or Tools > Macro > Macros........
There will only be one Macro. Select it and Press Run

This routine will open Excel and open file CableTrays.XLS,
Loop through the table, draw each tray and fill it with cables to capacity of the tray.
The number of rows, number of cables per row/layer, and the total number of cables are entered in Excel

If Excel was open when the macro was run it will leave Excel open.
if not it will close the Application.

The cables are *stacked" not "nested" and are allowed to protrude above the tray lip by up to 50% of the cable diameter.

The code is a "mixture" of the two VBa types.

Code:

' Required API routines:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long
                    
Sub DrawCables()
    DrawCablesFromExcelFile "C:\Users\Alistair\AutoCAD\CableTrays.XLS", "Sheet1"
End Sub

Sub DrawCablesFromExcelFile(FileNameAndPath As String, SheetName As String)
    Dim MyXL As Object
    Dim ExcelFound As Boolean

    ' Check if Excel is running.
    On Error Resume Next
    
    Set MyXL = GetObject(, "Excel.Application")
    
    If Err.Number <> 0 Then ExcelFound = True
    Err.Clear    ' Clear Err object in case error occurred.

    ExcelFound = DetectExcel

    ' Set the object variable to reference the file you want to use.
    Set MyXL = GetObject(FileNameAndPath)

    ' Show Microsoft Excel.
    MyXL.Application.Visible = True
    MyXL.Parent.Windows(1).Visible = True
    
    ' Draw in AutoCAD
    Dim TrayWidth As Double, TrayHeight As Double, CableDia As Double, offsetY As Double
    Dim r As Integer
    
    offsetY = 0
    r = 2
    
    With MyXL.sheets(SheetName)
        .Activate
        Do
            TrayWidth = CDbl(.cells(r, "A"))
            TrayHeight = CDbl(.cells(r, "B"))
            CableDia = CDbl(.cells(r, "C"))
            
            NoRows = Int(TrayHeight / CableDia)
            If TrayHeight Mod CableDia >= CableDia / 2 Then
                NoRows = NoRows + 1
            End If
            NoCols = Int(TrayWidth / CableDia)
            ' Enter in Excel
            .cells(r, "D") = NoRows
            .cells(r, "E") = NoCols
            .cells(r, "F") = NoRows * NoCols
            
            DrawTray TrayWidth, TrayHeight, offsetY
            DrawCableArray TrayWidth, TrayHeight, CableDia, offsetY
            offsetY = offsetY - (2 * TrayHeight)
            r = r + 1
            If .cells(r, "A") = "" Then Exit Do
        Loop
    End With
    
    ZoomAll
    ' If Excel was not open Close Excel else leave it open
    If Not ExcelFound Then
        MyXL.Application.Quit
    End If
    ' Release reference Excel and spreadsheet.
    Set MyXL = Nothing
    
End Sub

Function DetectExcel() As Boolean
    ' Function to dectect a running Excel instance and register it.
    Const WM_USER = 1024
    
    Dim hWnd As Long
    ' If Excel running - API call to returns its handle.
    hWnd = FindWindow("XLMAIN", 0)
    If hWnd = 0 Then  ' 0 = Excel not running.
        DetectExcel = False
        Exit Function
    Else              ' Excel is running - SendMessage API enters it in the Running Object Table.
        SendMessage hWnd, WM_USER + 18, 0, 0
        DetectExcel = True
    End If
End Function

Private Sub DrawTray(TrayWidth As Double, TrayHeight As Double, offsetY As Double)
    Dim aline As AcadLine
    Dim startPt(0 To 2) As Double
    Dim endPt(0 To 2) As Double

    'TrayBase
    startPt(0) = 0#: startPt(1) = offsetY: startPt(2) = 0#
    endPt(0) = TrayWidth: endPt(1) = offsetY: endPt(2) = 0#
    Set aline = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    aline.Update
    'TrayWalls
    endPt(0) = 0#: endPt(1) = TrayHeight + offsetY: endPt(2) = 0#
    Set aline = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    aline.Update
    startPt(0) = TrayWidth: startPt(1) = offsetY: startPt(2) = 0#
    endPt(0) = TrayWidth: endPt(1) = TrayHeight + offsetY: endPt(2) = 0#
    Set aline = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    aline.Update
End Sub

Private Sub DrawCableArray(TrayWidth As Double, TrayHeight As Double, CableDia As Double, offsetY As Double)
    Dim cCable As AcadCircle
    Dim Centre(0 To 2) As Double
    Dim Radius As Double, CableOffset As Double
    
    Radius = CableDia / 2
    CableOffset = Int(TrayWidth / CableDia) * CableDia
    CableOffset = (TrayWidth - CableOffset) / 2
    'Draw first Cable
    Centre(0) = Radius + CableOffset: Centre(1) = Radius + offsetY: Centre(2) = 0#
    
    Set cCable = ThisDrawing.ModelSpace.AddCircle(Centre, Radius)
    cCable.Update
    
    ' Define the Cable Array
    Dim NoRows As Long
    Dim NoCols As Long
    Dim NoLevels As Long
    Dim offsetRows As Double
    Dim offsetCols As Double
    Dim offsetLevels As Double
    
    NoRows = Int(TrayHeight / CableDia)
    If TrayHeight Mod CableDia >= CableDia / 2 Then
        NoRows = NoRows + 1
    End If
    
    NoCols = Int(TrayWidth / CableDia)
    NoLevels = 2
    offsetRows = CableDia
    offsetCols = CableDia
    offsetLevels = 1
    
    ' Create the array of objects
    Dim retObj As Variant
    retObj = cCable.ArrayRectangular(NoRows, NoCols, NoLevels, offsetRows, offsetCols, offsetLevels)
    
    ThisDrawing.Regen acActiveViewport

End Sub

I have only tried this in AutoCAD 2005 and Excel 2003, but it should be okay in other versions.

Hope this might be of some help.