style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
This
is a copy of most of the code. I have added as many comments as I can so
someone might beable to follow it. there are 2 or 3 functions that are called
that are in dll's and are not here.
Wayne Lefferd
Sub aaa()
Dim xxx As Variant
Dim Cnt As Integer
Dim XrefName As
Variant
XrefName = wl.Get_XrefName 'returns an array of xref names in the drawing
this function is in a dll and not here
xxx =
Image_List_From_Xref(XrefName(0)) 'returns an array of the block names in the
drawing that is xref in the drawing
'
the program is not continuming beyond this point
If VarType(xxx) > 8000
Then 'check to see if the above function retruned an array or not
xxx(21,
0) = xxx(21, 0) ' the rest of this is just checking to see what was returned
xxx(21, 1) = xxx(21, 1)
xxx(21, 2)(0) = xxx(21, 2)(0)
xxx(21, 3) =
xxx(21, 3)
xxx(1, 0) = xxx(1, 0)
Cnt = UBound(xxx)
Cnt = Cnt
End If
End Sub
Function Image_List_From_Xref(ByVal XrefName As String)
Dim ent As
AcadEntity
Dim SSet1 As AcadSelectionSet
Dim TempSortedList As Variant
Dim TempArray() As Variant
Dim Cnt As Integer
Dim Image_Name As
String
Dim TempUnSortedList As Variant
ThisDrawing.Application.Documents.Open XrefName + ".dwg", True ' opens the
xref drawing in read only mode
TempUnSortedList = ImageBlock_List 'returns a list of the blocks in an
unsorted older
If VarType(TempUnSortedList) > 8000 Then ' if there are no image blocks
the function will return 0
TempSortedList =
wl.ArraySorter(TempUnSortedList) 'sorts the array of block names. this
function is in a dll and not here
ReDim
TempArray(UBound(TempSortedList), 3) ' sets up a two dim array the length of
the block list
For Cnt = 0 To UBound(TempSortedList) 'goes theough the sorted block name
list looking for additional info about the blocks
Image_Name
= TempSortedList(Cnt) 'gets an single block name to get info on
Set
SSet1 = wl.Make_Selection_Set_All(0, "INSERT", 2, Image_Name) ' sets up a
selection set for all inserted items with a certain named block
If
SSet1.Count > 0 Then 'makes sure it found at least one block with the
correct name
For
Each ent In SSet1 'pulling off data from block
TempArray(Cnt,
0) = ent.Name
TempArray(Cnt,
1) = ent.Name
TempArray(Cnt,
2) = ent.insertionPoint
TempArray(Cnt,
3) = ent.XScaleFactor
Next
ent
End
If
Next Cnt
Image_List_From_Xref =
TempArray 'sets up to return array if it has any information
Else
Image_List_From_Xref = 0 '
set up to return 0 if it found nothing
End If
ThisDrawing.Close ,
False 'closes the drawing and does not save, must have false because drawing
opened in read only mode
'
it works fine (except for closing the drawing) if I comment out this line
End Function
Function ImageBlock_List()
Dim Block_Names() As String
Dim ent As
AcadEntity
Dim SSet1 As AcadSelectionSet
Dim Cnt As Integer
Set
SSet1 = wl.Make_Selection_Set_All(0, "INSERT", 2, "Image_*") ' returns a
selection set for all inserts in drawing with names starting with "Image_*"
If SSet1.Count > 0 Then ' stops if it found no matches
ReDim Block_Names(SSet1.Count - 1)
For Each ent In SSet1 ' getting name off blocks
Block_Names(Cnt)
= ent.Name ' puts names in array
Cnt
= Cnt + 1
Next ent
End If
ImageBlock_List = wl.ArraySorter(Block_Names) 'returns sorted array of
block names. function not here its in dll
End Function
