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
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