dan113 Posted April 1, 2015 Share Posted April 1, 2015 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 2, 2015 Share Posted April 2, 2015 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 Quote Link to comment Share on other sites More sharing options...
dan113 Posted April 2, 2015 Author Share Posted April 2, 2015 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 Quote Link to comment Share on other sites More sharing options...
rexxitall Posted April 15, 2015 Share Posted April 15, 2015 (edited) 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 April 15, 2015 by rexxitall Quote Link to comment Share on other sites More sharing options...
SLW210 Posted April 15, 2015 Share Posted April 15, 2015 Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags. Quote Link to comment Share on other sites More sharing options...
rexxitall Posted April 15, 2015 Share Posted April 15, 2015 Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags. Happy now ? Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.