Add a block with attributes in AutoCAD with an Excel macro VBA

Description :
This macro creates a block with attributes (one of them is invisible to the user : "mode = acAttributeModeInvisible").
Here, I've created a manhole block but you can add and change each parameters to see their respective influence on the drawing.

Don't forget :
if you launch this macro many time with the same insertion point, you'll get nested block with repetitive attributes.
'------------------------ THE VBA CODE ------------------------------------
Sub MANHOLEBLOCK()

On Error Resume Next
 With ThisWorkbook.VBProject.References
 Application.DisplayAlerts = False
 .AddFromFile "C:\Program Files\Common Files\Autodesk Shared\acax17fra.tlb"
 End With
 Application.DisplayAlerts = True
 On Error GoTo 0
 '..la suite


Dim AcadApp As AcadApplication
Dim AcadDoc As AcadDocument

On Error Resume Next

Set AcadApp = GetObject(, "AutoCAD.Application.17")
If Err Then
Err.Clear
Set AcadApp = CreateObject("AutoCAD.Application.17")
End If

MsgBox "Now running! : " + AcadApp.Name + " version :" + AcadApp.Version

Set AcadDoc = AcadApp.Application.ActiveDocument

AcadDoc.Regen acActiveViewport
ZoomAll
AcadApp.Application.Visible = True



    ' Define the block
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    Set blockObj = AcadDoc.Blocks.Add _
                     (insertionPnt, "MANHOLE")

    ' Add an attribute to the block
    Dim attributeObj1 As AcadAttribute
    Dim height1 As Double
    Dim mode1 As Long
    Dim prompt1 As String
    Dim insertionPoint1(0 To 2) As Double
    Dim tag1 As String
    Dim value1 As String
    height1 = 1
    mode1 = acAttributeModeVerify
    prompt1 = "Give plateform Level "
    insertionPoint1(0) = 3
    insertionPoint1(1) = 3
    insertionPoint1(2) = 0
    tag1 = "fil d'eau 1"
    value1 = Range("G16")
    Set attributeObj1 = blockObj.AddAttribute(height1, mode1, _
                          prompt1, insertionPoint1, tag1, value1)
                        
                        
    ' Add an attribute to the block
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1
    mode = acAttributeModeInvisible
    prompt = "Give invert Level 2"
    insertionPoint(0) = -2
    insertionPoint(1) = 3
    insertionPoint(2) = 0
    tag = "fil d'eau 2"
    value = Range("h16")
    Set attributeObj = blockObj.AddAttribute(height, mode, _
                          prompt, insertionPoint, tag, value)
    ' Insert the block, creating a block reference
    ' and an attribute reference
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2
    insertionPnt(1) = 2
    insertionPnt(2) = 0
    Set blockRefObj = AcadDoc.ModelSpace.InsertBlock _
               (insertionPnt, "MANHOLE", 1#, 1#, 1#, 0)

End Sub

No comments:

Post a Comment