[VBA] Changing Dynamic Block Property Values

[fredpox82]

Dear All,

I'm developing a simple function in Excel that updates the property values of a Autocad dynamic block but I'm struggling with the assignment of numeric values.

I've been able to get the properties of the dyn block and store them in a variant variable, and I created a for-next cicle to loop through them to look for the PropertyName I want to set. Apparently the issue is the format of the value I pass.

Here is my function:

Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Variant, Optional sAttrTag2 As String, Optional ByVal sVal2 As Variant, Optional sAttrTag3 As String, Optional ByVal sVal3 As Variant, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As String)

Dim objEnt As AcadEntity
Dim objBlock As AcadBlock
Dim objAttrib As AcadAttribute
Dim objAttribs As Collection
Dim dynBlkProp As Variant
Dim iCount As Integer

iCount = 0

'Debug.Print acadDoc.FullName
Set objBlock = acadDoc.Blocks.Item(sBlk)

If objBlock.IsDynamicBlock Then

'get properties from dynamic BlockObj
Dim dybprop As Variant, i As Integer
Dim bobj As AcadEntity
    For Each bobj In acadDoc.ModelSpace 'Get AutoCAD Entity's
        Debug.Print bobj.ObjectName
        If bobj.ObjectName = "AcDbBlockReference" Then 'Check if BlockRef
            If bobj.IsDynamicBlock Then 'Check to see if it is a Dynamic Block
            dybprop = bobj.GetDynamicBlockProperties
                If bobj.EffectiveName = sBlk Then 'Finds Dynamic Block NAME
                For i = LBound(dybprop) To UBound(dybprop) 'Goes through Results
                    Dim oProp As AcadDynamicBlockReferenceProperty
                    
                    Set oProp = dybprop(i)
                    Select Case oProp.PropertyName
                        Case sAttrTag1
                            oProp.Value = sVal1
                            iCount = iCount + 1
                        Case sAttrTag2
                            oProp.Value = sVal2
                            iCount = iCount + 1
                        Case sAttrTag3
                            oProp.Value = sVal3
                            iCount = iCount + 1
                        Case sAttrLng
                            oProp.Value = sValLng
                            iCount = iCount + 1
                    End Select
                Next i
                End If
            End If
        End If
    Next

    ' synchronize definition of block attributes
    acadDoc.SendCommand ("attsync n " & sBlk & vbCr)
    
    MsgBox "Done. Successfully updated  " & iCount & " dyn blocks."
    iCount = 0

    If bAttr = True Then GoTo 10


Else

[...]

End If

End Function

 And this is how I call the function

Call ChangeAttr_PP(sBlkPnt, "D_Lung", sBldLung & "#", , , , , True, "Visibility1", sLng)

Actually, D_Lung is the PropertyName and sBldLung is the string variable in which I store the value to set.

I read in this article that the numeric values shall be passed as NUM#, hence I added the hash (#) at the end of my value.

Unluckily It happes that it works if I enter directly the value (i.e. if I write 66#) but it doesn't if I pass it as a variable.

Any help would be much appreciated.

Thank you

bye

P

[RICVBA]

just a shot guess: since the online help states

"Value

    DynamicBlockReferenceProperty objects: Variant; read-write
    The current value for the property"

so you could use the CVar() function to pass a variant parameter (...,CVar(sBldLung & "#") ,...)

[fredpox82]

Dear Ric, thank you for your support.

I tried your hint but unluckily it doesn't work.

I still get "runtime error '-2145386493 (80200003)' Invalid input".

I tried various combinations even "manually" (i.e. CVar(2000 & "#") , CVar("2000#"), assigning a string value to an external Variant variable and passing the variable to my Call function).

No way, the only way it seems to accept the input is if I pass it directly: 2000# or CVar(2000#) are ok, but no chance to get it working by passing the data from variable.

Thanks again for your help.

best regards.

P

[RICVBA]

sorry for that

I'm not using dynamic blocks but if you want you may post a dwg with some of them you're having problems with and I'll try and see if I can get out of it

bye

[fredpox82]

Dear Ric, thank you for your kindness and support. I'll be able to upload a sample dwg in a few hours.

Have a nice day
P

[fredpox82]

Dear Ric,

please find attached the dynamic block sample.

The properties I want to set are D_Alt and D_TLung.

The possible values are stored in a list within the block itself:

D_Alt allows the user to input two values: 2659 or 2959

D_TLung allows the user to input two values: 2400 or 2890

Another parameter I want to change is Visibility1, which I can set to ITA, ENG or FRA.

The value types for D_Alt and D_TLung are integers, while Visibility1 the input is a string value.

Thank you

P

[RICVBA]

well, the follwoing code works in my Autocad 2010

Option Explicit

Sub main()
Dim sBlkPnt As String
Dim sLng As String
Dim sBldLung As Double

sBlkPnt = "501_T_Prospetto"
sBldLung = 2400#
sLng = "ITA"
Call ChangeAttr_PP(sBlkPnt, "D_TLung", sBldLung, , , , , True, "Visibility1", sLng)

End Sub

Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Variant, Optional sAttrTag2 As String, Optional ByVal sVal2 As Variant, Optional sAttrTag3 As String, Optional ByVal sVal3 As Variant, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As String)
Dim objBlock As AcadBlock
Dim objBlockRef As AcadBlockReference
Dim iCount As Integer

Dim dybprop As Variant, i As Integer

Dim acadDoc As AcadDocument ' added by RICVBA
Set acadDoc = ThisDrawing ' added by RICVBA

iCount = 0

'Debug.Print acadDoc.FullName
Set objBlock = acadDoc.Blocks.Item(sBlk)

If objBlock.IsDynamicBlock Then

    Dim ssetObj As AcadSelectionSet
    Set ssetObj = BlocksSset()
    
    For Each objBlockRef In ssetObj 'iterate through reference blocks collection
        Debug.Print objBlockRef.ObjectName
        
        If objBlockRef.IsDynamicBlock Then 'Check to see if it is a Dynamic Block
        
            dybprop = objBlockRef.GetDynamicBlockProperties
            For i = LBound(dybprop) To UBound(dybprop) 'iterate through dynamic block properties
                With dybprop(i)
                    Select Case .PropertyName
                        Case sAttrTag1
                            .Value = sVal1
                            iCount = iCount + 1
                        Case sAttrTag2
                            .Value = sVal2
                            iCount = iCount + 1
                        Case sAttrTag3
                            .Value = sVal3
                            iCount = iCount + 1
                        Case sAttrLng
                            .Value = sValLng
                            iCount = iCount + 1
                    End Select
                End With
            Next i
            
        End If
        
    Next

    ' synchronize definition of block attributes
    acadDoc.SendCommand ("attsync n " & sBlk & vbCr)
    
    MsgBox "Done. Successfully updated  " & iCount & " dyn blocks."
    iCount = 0


Else

'[...]

End If

End Function


Function BlocksSset() As AcadSelectionSet

Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim ssetObj As AcadSelectionSet

gpCode(0) = 0:  dataValue(0) = "INSERT"
On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets.Item("BlocksSset")
If Err <> 0 Then
    Set ssetObj = ThisDrawing.SelectionSets.Add("BlocksSset")
Else
    ssetObj.Clear
End If
On Error GoTo 0
ZoomExtents
ssetObj.Select acSelectionSetAll, , , gpCode, dataValue
Set BlocksSset = ssetObj
    
End Function

 hope with yours too

bye

[fredpox82]

Dear Ric,

thanks a lot for your support.

I tried your code but still I was getting issues for data type mismatch.

In your Main you set

sBldLung = 2400#

but I get the sBldLung value via variable, and I have no chance to even set sBldLung as Double like you did.

Just for a last shot I tried to add an integer to the actual property value and I did it!

I mean, I changed Function ChangeAttr_PP like this

[...]
With dybprop(i)
                    Select Case .PropertyName
                        Case sAttrTag1
                            .Value = sVal1
                            .Value = .Value + 100
                            iCount = iCount + 1
[...]

Hence, I managed to change the assignments to variable sBldLung getting its value by difference from defaultValue Const. I changed the data type for sBldLung to Integer and run the function again. It worked too!

Your hints were inspiring, thank you!

There's just one more thing I'd like to ask you about the BlocksSset function you wrote.

I have several dyn blocks in my drawing, and each one now updates great, but the function create a new instance of one block.

That's the dyn block I gave you as a sample: when I start with my template dwg I have two of them, but when the function ends, a third one is visible over another. The 'additional' block appears as soon as the ChangeAttr_PP is invoked the second time (on the following command string

Call ChangeAttr_PP(sBlkPspT, "D_Alt", sBldAlt, "D_TLung", sBldLarg, , , True, "Visibility1", sLng)

BlocksSset function inserts a new block in the same insertion point of the existing one.

Thanks again.

bye

P

[RICVBA]

"but I get the sBldLung value via variable, and I have no chance to even set sBldLung as Double like you did."

you may want to post some relevant snippets of your code so as to let me see if I can find a way to set properties values directly

In any case, following your path of setting the property value in a "relative" way, I can suggest you to use AllowedValues property directly

like follows

Option Explicit

Sub main()
Dim sBlkPnt As String
Dim sLng As String
'Dim sBldLung As Double
Dim iBldLung As Integer, iBldAlt As Integer, iBldLng As Integer

sBlkPnt = "501_T_Prospetto"
iBldAlt = 1 ' 0 = 2659 , 1 = 2959
'sBldLung = 2400#
iBldLung = 1 ' 0 = 2400 , 1 = 2890
'sLng = "ITA"
iBldLng = 1 ' 0 = "ITA" , 1 = "ENG", 2 = "FRA"

'Call ChangeAttr_PP(sBlkPnt, "D_TLung", sBldLung, , , , , True, "Visibility1", sLng)
Call ChangeAttr_PP(sBlkPnt, "D_TLung", iBldLung, "D_Alt", iBldAlt, , , True, "Visibility1", iBldLng)

End Sub

'Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Variant, Optional sAttrTag2 As String, Optional ByVal sVal2 As Variant, Optional sAttrTag3 As String, Optional ByVal sVal3 As Variant, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As String)
Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Integer, Optional sAttrTag2 As String, Optional ByVal sVal2 As Integer, Optional sAttrTag3 As String, Optional ByVal sVal3 As Integer, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As Integer)
Dim objBlock As AcadBlock
Dim objBlockRef As AcadBlockReference
Dim iCount As Integer, iobj As Integer

Dim dybprop As Variant, i As Integer
Dim sVal As Variant, obj As Variant
Dim okCase As Boolean

Dim acadDoc As AcadDocument ' added by RICVBA
Set acadDoc = ThisDrawing ' added by RICVBA

iCount = 0

'Debug.Print acadDoc.FullName
Set objBlock = acadDoc.Blocks.Item(sBlk)

If objBlock.IsDynamicBlock Then

    Dim ssetObj As AcadSelectionSet
    Set ssetObj = BlocksSset()
    
    For Each objBlockRef In ssetObj 'iterate through reference blocks collection
        Debug.Print objBlockRef.ObjectName
        
        If objBlockRef.IsDynamicBlock Then 'Check to see if it is a Dynamic Block
        
            dybprop = objBlockRef.GetDynamicBlockProperties
            For i = LBound(dybprop) To UBound(dybprop) 'Goes through Results
                
                With dybprop(i)
                    okCase = True
                    Select Case .PropertyName
                        Case sAttrTag1
                            sVal = sVal1
                        Case sAttrTag2
                            sVal = sVal2
                        Case sAttrTag3
                            sVal = sVal3
                        Case sAttrLng
                            sVal = sValLng
                        Case Else
                            okCase = False
                    End Select
                    
                    If okCase Then
                        iobj = 0
                        For Each obj In .AllowedValues
                            If iobj = sVal Then
                                .Value = obj
                                iCount = iCount + 1
                                Exit For
                            End If
                            iobj = iobj + 1
                        Next obj
                    End If

                End With
            Next i
            
        End If
        
    Next

    ' synchronize definition of block attributes
    acadDoc.SendCommand ("attsync n " & sBlk & vbCr)
    
    MsgBox "Done. Successfully updated  " & iCount & " dyn blocks."
    iCount = 0


Else

'[...]

End If

End Function


Function BlocksSset() As AcadSelectionSet

Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim ssetObj As AcadSelectionSet

gpCode(0) = 0:  dataValue(0) = "INSERT"
On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets.Item("BlocksSset")
If Err <> 0 Then
    Set ssetObj = ThisDrawing.SelectionSets.Add("BlocksSset")
Else
    ssetObj.Clear
End If
On Error GoTo 0
ZoomExtents
ssetObj.Select acSelectionSetAll, , , gpCode, dataValue
Set BlocksSset = ssetObj
    
End Function

so that your preprocessing routine can first set the integer values iBldAlt, iBldLung and iBldLng accordingly to the variable values you get from "outside" and then have your ChangeAttr_PP routine use the proper properties values as allowed by the block

finally as for the creation of new instances of the dynamics block, it's a behaviour I don't see running my routine with your dwg

and it sound weird also, since BlocksSset function only set and fill a selectionset which in itself doesn't add any new drawing entity in the drawing

if you post me a drawing and the vba code that have that behaviour I may dig into them

bye

[fredpox82]

Dear Ric, sorry for the late reply but I've been off the last days.

I dimensioned sBldLung (I tried to set as Integer, or Double, or Variant) as a global variable in my module.

I assign its value gettin it from Excel with the following statement

'I dimension sBldLung as a global variable (I tried to set it as String, Integer, Double and Variant without success)

Dim sBldLung As Variant

'then I assign its value in my main Sub

Sub GenerateDWG()

'[...]

sBldLung = ActiveSheet.Cells(6, 2)

'[...]

'then I open AutoCAD file to process and call the function ChangeAttr_PP passing the variable sBldLung
acadApp.Documents.Open sFilename, False
Set acadDoc = acadApp.ActiveDocument
acadDoc.Activate

Call ChangeAttr_PP(sBlkPnt, "D_Lung", sBldLung, , , , , True, "Visibility1", sLng)

End sub

My ChangeAttr_PP generates an error as soon as I try to change the D_Lung property value in my sBlkPnt dyn block (Invalid input ....)

Anyway, if you want to dig more into this I'd be glad but for the moment I'm ok with the solution I found (assigning the property value by difference, that is

dybprop(i).Value = dybprop(i).Value + (sBldLung-dybprop(i).Value)

As for the duplicated block err.. nevermind, I had an overlapping in my template. My fault.

Thanks again for your support.

Have a nice weekend.

P

[RICVBA]

here's the code for reading from an excel worksheet

Option Explicit
Dim sBldLung As Variant

Sub GenerateDWG()
Dim sBlkPnt As String
Dim sLng As String
'Dim sBldLung As Double

Dim Excel As Application
Dim MySheet As Excel.Worksheet

Set MySheet = getExcelActiveSheet(Excel)
If MySheet Is Nothing Then Exit Sub

'sBldLung = 2400#
sBldLung = MySheet.Cells(6, 2)

sBlkPnt = "501_T_Prospetto"
sLng = "ITA"
Call ChangeAttr_PP(sBlkPnt, "D_TLung", sBldLung, , , , , True, "Visibility1", sLng)

Set MySheet = Nothing
Set Excel = Nothing

End Sub

Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Variant, Optional sAttrTag2 As String, Optional ByVal sVal2 As Variant, Optional sAttrTag3 As String, Optional ByVal sVal3 As Variant, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As String)
Dim objBlock As AcadBlock
Dim objBlockRef As AcadBlockReference
Dim iCount As Integer

Dim dybprop As Variant, i As Integer

Dim acadDoc As AcadDocument ' added by RICVBA
Set acadDoc = ThisDrawing ' added by RICVBA

iCount = 0

'Debug.Print acadDoc.FullName
Set objBlock = acadDoc.Blocks.Item(sBlk)

If objBlock.IsDynamicBlock Then

    Dim ssetObj As AcadSelectionSet
    Set ssetObj = BlocksSset()
    
    For Each objBlockRef In ssetObj 'iterate through reference blocks collection
        Debug.Print objBlockRef.ObjectName
        
        If objBlockRef.IsDynamicBlock Then 'Check to see if it is a Dynamic Block
        
            dybprop = objBlockRef.GetDynamicBlockProperties
            For i = LBound(dybprop) To UBound(dybprop) 'iterate through dynamic block properties
                With dybprop(i)
                    Select Case .PropertyName
                        Case sAttrTag1
                            .Value = sVal1
                            iCount = iCount + 1
                        Case sAttrTag2
                            .Value = sVal2
                            iCount = iCount + 1
                        Case sAttrTag3
                            .Value = sVal3
                            iCount = iCount + 1
                        Case sAttrLng
                            .Value = sValLng
                            iCount = iCount + 1
                    End Select
                End With
            Next i
            
        End If
        
    Next

    ' synchronize definition of block attributes
    acadDoc.SendCommand ("attsync n " & sBlk & vbCr)
    
    MsgBox "Done. Successfully updated  " & iCount & " dyn blocks."
    iCount = 0


Else

'[...]

End If

End Function

Function getExcelActiveSheet(Excel As Application) As Excel.Worksheet

Dim MySheet As Excel.Worksheet

' handling excel application
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err Then
    MsgBox "No Excel application is running" & vbCrLf & "the sub ends"
Else
    ' handling workbook and worksheet
    Err.Clear
    With Excel
        Set MySheet = .ActiveWorkbook.ActiveSheet
        If Err Then
            MsgBox "No active Worksheet found" & vbCrLf & "the sub ends"
        Else
            Set MySheet = .ActiveWorkbook.ActiveSheet
        End If
    End With
End If
On Error GoTo 0

Set getExcelActiveSheet = MySheet

End Function

I started from my first code and sligthly adapted it for handling input from an excel worksheet and therefore adding getExcelActiveSheet() function

while the BlocksSset() function remains the same

in my Autocad 2010 & Excel 2010 environment it works!

bye

[Profmanprof]

hello all

Are We Make that VBA to Lsp Version.???

HAVE NİCE DAY...

[Jessye_1977]

Hello Ric,

I've come across some of your VBA solutions and am hopeful that you can help me.

what i want to accomplish is to have a text field that displays the visibility state of a dynamic block. The field itself is referenced from an Excel program, where a person can input data that represents the visibility state of the dynamic block, and as the input data changes, so does the dynamic block visibility state. 

Here is the why. I am currently in the process of setting up dwg templates for my company, and compiling a lot of geometry into dynamic blocks that change depending on the design needs to alleviate the chances for errors from our less experienced CAD operators. In essence, the dwgs will have several different dynamic blocks so I will want to be able to either have one code that will reference all dynamic blocks within the dwg with their visibility states being changed by a corresponding text field that is referenced from the Excel calculator that I have written for the design process. Ideally, the code would reference the blocks handle to select the block, since it will never change, or some other automatic process that will allow the dwt to be used several times and saved as a dwg. I would like to not have the CAD operator to have to manually select anything, or have to manually load a VBA code each time the dwt is used to make a set of plans, that way, anybody can open the Excel file, make the necessary design parameter changes, open AutoCAD, and print the necessary sheets with all dynamic blocks updated to the correct visibility states. 

I know very VERY little about VBA or AutoLISP programming, I have been trying to teach myself via internet forums, books, etc for the last 6 months, but I feel as if I'm not getting anywhere with the process and feel as if I'm quickly losing my mind! 🙂 I will post this on the forum as well so that i can attach a sample of a dynamic block with more information on the dwg itself. Any help, or push in the right direction would be appreciated. 

Thank you,

Jessye