Jump to content

VBA dynamic blocks edit


dan113

Recommended Posts

Hi, iv got the below vba in progress, i copied it from somewhere online but cannot remember where to give credit :(

 

Anyway iv got it running from a userform but it will only update the last block inserted. Eventually i want to use it to control 5+ dynamic block, also with visibility states but im at a loss after trying multiple things over the last few hours. Can someone point me in the right direction please?

 

Public Sub block_dyn()


Dim objBlock As AcadBlockReference
8
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim ssetObj As AcadSelectionSet
               
On Error Resume Next
ThisDrawing.SelectionSets.Item("SS1").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("SS1")

FilterType(0) = 0
FilterData(0) = ""
ssetObj.Select acSelectionSetAll, p1, p2, FilterType, FilterData

For Each Item In ssetObj
   If objBlock.EffectiveName = "Box" Then
       Set objBlock = ssetObj.Item(n)
       Call dyn_prop(objBlock, "Width", TextBox3.Value)
       Call dyn_prop(objBlock, "Height", TextBox4.Value)
       
   End If
       
   If objBlock.EffectiveName = "Rect" Then
       Call dyn_prop(objBlock, "Thickness", TextBox3.Value)
       Call dyn_prop(objBlock, "Depth", TextBox4.Value)
   End If
Next

End Sub

Public Sub dyn_prop(objBlock As AcadBlockReference, name_of_property As String, value_of_property As Double)

Dim dyn_properties() As AcadDynamicBlockReferenceProperty
Dim var_atts As Variant

var_atts = objBlock.GetDynamicBlockProperties

   For i = LBound(var_atts) To UBound(var_atts)
       If var_atts(i).PropertyName = name_of_property Then
           var_atts(i).Value = value_of_property
           ThisDrawing.SendCommand "_regen" & vbCr
       End If
   Next

End Sub

 

Thanks in advance

~D

Link to comment
Share on other sites

My $0.05 I just manage to do VBA stuff your selection set is looking at all of the dwg.

 

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"
Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal


' also if you pick one block then something like this
attribs = SS.Item(Cntr).GetAttributes

    If attribs(0).TextString = pitname Then
      pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")
      txtx1 = CStr(FormatNumber(pt1(0), 3))
      TXTY1 = CStr(FormatNumber(pt1(1), 3))

       attribs(1).TextString = txtx1
       attribs(2).TextString = TXTY1

       attribs(1).Update
       attribs(2).Update
'        ThisDrawing.Application.Update

Link to comment
Share on other sites

so i got the vba changing multiple blocks in the drawing with the code below.

 

my next part is to change the visibility state but i cannot find any info anywhere on doing this.

 

My aim is to create a userform with tickboxes which will set the visibility state

Any ideas?

 

Public Sub block_dyn()


Dim objBlock As AcadBlockReference
8
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim ssetObj As AcadSelectionSet
               
On Error Resume Next
ThisDrawing.SelectionSets.Item("SS1").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("SS1")

FilterType(0) = 0
FilterData(0) = "INSERT"
ssetObj.Select acSelectionSetAll, p1, p2, FilterType, FilterData

Dim dyn_properties() As AcadDynamicBlockReferenceProperty
Dim var_atts As Variant
Dim n As Integer
n = 0
'For Each Item In ssetObj
While n < ssetObj.Count
   Set objBlock = ssetObj.Item(n)
   If objBlock.EffectiveName = "Box" Then
       'Set objBlock = ssetObj.Item(n)
       Call dyn_prop(objBlock, "Width", 100)
       Call dyn_prop(objBlock, "Height", 100)
       
   End If
       
   If objBlock.EffectiveName = "Rect" Then
       Call dyn_prop(objBlock, "Thickness", 150)
       Call dyn_prop(objBlock, "Height", 150)
   End If
   n = n + 1
Wend
'Next
   'ThisDrawing.SendCommand "_regen" & vbCr

End Sub

Public Sub dyn_prop(objBlock As AcadBlockReference, name_of_property As String, value_of_property As Double)

Dim dyn_properties() As AcadDynamicBlockReferenceProperty
Dim var_atts As Variant

var_atts = objBlock.GetDynamicBlockProperties

   For i = LBound(var_atts) To UBound(var_atts)
       If var_atts(i).PropertyName = name_of_property Then
           var_atts(i).Value = value_of_property
           ThisDrawing.SendCommand "_regen" & vbCr
       End If
   Next

End Sub

Link to comment
Share on other sites

  • 2 weeks later...
those routines are known as working.
to set a parameter just give its value as text string
so e.g. the visibility state name

instead of sentcommand try
thisdrawing.renegen all

best regards

Function block_set_parameter(blockref As AcadBlockReference, ByVal NAME As String, VALUE As Variant, Optional ucaseName As Boolean = True) As Boolean
   block_set_parameter = False
   If blockref Is Nothing Then Exit Function
   Dim DynProp As AcadDynamicBlockReferenceProperty
   Dim PROPNAME As String
   Dim Variable As Variant
   Dim temp As String
   Dim BV As Variant
   If ucaseName Then NAME = UCase(NAME)
   Variable = blockref.GetDynamicBlockProperties
   For K = LBound(Variable) To UBound(Variable)
       Set DynProp = Variable(K)
       PROPNAME = DynProp.PropertyName
       If ucaseName Then PROPNAME = UCase(PROPNAME)
       'Check for variable and when found ask for input
       If PROPNAME = NAME Then
           If DynProp.ReadOnly = False Then
               BV = DynProp.VALUE
               On Error Resume Next
               err.Clear
               If DynProp.VALUE <> VALUE Then
                   DynProp.VALUE = VALUE
               End If
               If err.number = 0 Then block_set_parameter = True
               On Error GoTo 0
               err.Clear
               Exit Function
           End If
       End If
   Next
   On Error GoTo 0
End Function

Function block_get_parameter(ByRef v As Variant, blockref As AcadBlockReference, ByVal NAME As String, Optional ucaseName As Boolean = True) As Boolean

   Dim DynProp As AcadDynamicBlockReferenceProperty
   Dim Variable As Variant
   Dim PROPNAME As String
   Dim temp As String
   If ucaseName Then NAME = UCase(NAME)
   block_get_parameter = False
   If blockref Is Nothing Then Exit Function
   If blockref.IsDynamicBlock Then
       Variable = blockref.GetDynamicBlockProperties

       For K = LBound(Variable) To UBound(Variable)
           Set DynProp = Variable(K)
           PROPNAME = DynProp.PropertyName
           If ucaseName Then PROPNAME = UCase(PROPNAME)
           If PROPNAME = NAME Then
               block_get_parameter = True
               v = DynProp.VALUE
               Exit For
           End If
       Next
   End If
End Function

Edited by rexxitall
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...