hEY mARK,
cHECK THIS OUT AND SEE IF IT'S WHAT YOU'RE AFTER. sfcl, sorry
Option Explicit
Public Sub blkCent()
Dim minExt As Variant
Dim maxExt As Variant
Dim strSetName As String
Dim intGroup(0) As Integer
Dim varGroup(0) As Variant
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Dim objBlkRef As AcadBlockReference
Dim objEnt As AcadEntity
Dim strName As String
Dim sysFileDia As Integer
Dim strFileName As String
Dim strWriteLine As String
Dim intFile As Integer
Set objSelSets = ThisDrawing.SelectionSets
strSetName = 1
intGroup(0) = 0
varGroup(0) = "insert"
KillSet strSetName
Set objSelSet = objSelSets.Add(strSetName)
objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
sysFileDia = ThisDrawing.GetVariable("FILEDIA")
ThisDrawing.SetVariable "FILEDIA", 0
For Each objEnt In objSelSet
If TypeOf objEnt Is AcadBlockReference Then
Set objBlkRef = objEnt
strName = objBlkRef.Name
objBlkRef.GetBoundingBox minExt, maxExt
ZoomWindow minExt, maxExt
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
strFileName = "C:\tempslide\" & ThisDrawing.GetVariable("dwgname") & ".lst"
'*****MAKE SURE THIS FOLDER EXISTS*****
intFile = FreeFile
Open strFileName For Append As #intFile
Print #intFile, strName & ".sld"
Close #intFile
End If
Next objEnt
ZoomExtents
ThisDrawing.SetVariable "FILEDIA", sysFileDia
End Sub
Function KillSet(strSet As String)
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Set objSelSets = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = strSet Then
ThisDrawing.SelectionSets.Item(strSet).Delete
Exit For
End If
Next
End Function