Message 1 of 5
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I xref'd some dynamic block stamps into all of our Client templates. I was trying to put some code together to run when drawings are open by users.
1. Check for xref stamp name
2. If found then bind/insert
3. Run through model space and all other layout tabs and explode "LEVG_ENG_STAMP" block
Everything works fine except after exploding, the block is sort of duplicated. It was exploded but there is still an unexploded block underneath the dynamic block. Test DWG attached with xref.
Also, even though I set the BINDTYPE var to 1, it prefixes the block and test styles from stamp with xref name $0$.
Any ideas what I could change to get it to explode and finish properly?
Option Explicit 'Find & bind Xref'd LevG_Eng_Stamp Sub FindBindXrefStamp() Dim abl As AcadBlock For Each abl In ThisDrawing.Blocks 'check for xrefs If abl.IsXRef Then 'Check for xref stamp name If abl.Name = "LevG_Eng_Stamp" Then 'MsgBox (abl.Name) & " Found" 'unlock xref layer 'Call LayerUnLock_Xref 'MsgBox "Layer UnLocked " & (abl.Name) 'set bindtype variable for xref ThisDrawing.SetVariable "BINDTYPE", 1 'bind/insert xref ThisDrawing.Blocks.Item(abl.Name).Bind False 'MsgBox "The external reference " & (abl.Name) & " is bound." 'this is where something needs to cycle through all layouts and explode stamp one time each 'Call LayerLock_Xref 'MsgBox "Layer Locked " & (abl.Name) End If End If Next End Sub 'Setting each layout to active layout before you can loop through each entity on that layout, 'as you did, may be good enough for your needs. But if the layouts have a lots of entities, 'setting a layout to active layout may 'trigger AutoCAD to regenerate the view, which may take time. 'Another way is to use AcadSelectionSet.Select() with layout name as filter, 'so that you do not need to set each layout to active layout. Sample code like this: Public Sub RunThruLayouts() Dim l As AcadLayout Dim ss As AcadSelectionSet Set ss = ThisDrawing.SelectionSets.Add("MySet") Call LayerUnLock_Xref For Each l In ThisDrawing.Layouts 'If UCase(l.Name) <> "MODEL" Then SelectEntitiesOnLayout l.Name, ss ''''MsgBox "Selected entities on layout """ & l.Name & """: " & ss.Count ''You then do something with the entities on the layout DoSomething ss 'End If Next ss.Delete Call LayerLock_Xref End Sub Private Sub SelectEntitiesOnLayout(layoutName As String, ss As AcadSelectionSet) ss.Clear Dim gpCode(0) As Integer Dim dataValue(0) As Variant gpCode(0) = 410 'Group Code for layout name dataValue(0) = layoutName Dim groupCode As Variant, dataCode As Variant groupCode = gpCode dataCode = dataValue ss.Select acSelectionSetAll, , , groupCode, dataCode End Sub 'explode stamp block Private Sub DoSomething(ss As AcadSelectionSet) Dim ent As AcadEntity Dim block As AcadBlockReference 'try this For Each ent In ss If TypeOf ent Is AcadBlockReference Then 'try this Set block = ent 'try this If UCase(block.EffectiveName) = "LEVG_ENG_STAMP" Then 'try this '''''explode here 'try this block.Explode 'MsgBox "Found it" End If 'try this End If 'try this 'MsgBox ent.ObjectName Next End Sub 'Create XREF layer if does not exist and lock layer Sub LayerUnLock_Xref() ' Create a new layer called "XREF" Dim layerObj As AcadLayer Set layerObj = ThisDrawing.Layers.Add("XREF") ' UnLock layer "XREF" layerObj.Lock = False End Sub 'Create XREF layer if does not exist and lock layer Sub LayerLock_Xref() ' Create a new layer called "XREF" Dim layerObj As AcadLayer Set layerObj = ThisDrawing.Layers.Add("XREF") ' Lock layer "XREF" layerObj.Lock = True End Sub
Solved! Go to Solution.