thanx for reply
Public Sub blockcount()
Dim myblkarray() As Variant
Dim i As Long, j As Long
Dim count As Integer
Dim Index As Integer
Dim FoundBlock As Boolean
On Error Resume Next
''find locked layers
For Each oLayer In ThisDrawing.Layers
If oLayer.Lock = True Then
If strLocked = "" Then
strLocked = "" & oLayer.Name
Else
strLocked = strLocked & "," & oLayer.Name
End If
End If
Next
''find xrefs
For Each oBlock In ThisDrawing.Blocks
If oBlock.IsXRef = True Then
If strXref = "" Then
strXref = "" & oBlock.Name
Else
strXref = strXref & "," & oBlock.Name
End If
End If
Next
''select blocks
Dim sset As AcadSelectionSet
Dim ftype(6) As Integer
Dim fdata(6) As Variant
''filters
Set sset = ThisDrawing.SelectionSets.Add("ssblock")
ftype(0) = 0: fdata(0) = "INSERT"
ftype(1) = -4: fdata(1) = "
ftype(2) = 8: fdata(2) = strLocked 'removes locked layers
ftype(3) = -4: fdata(3) = "NOT>"
ftype(4) = -4: fdata(4) = "
ftype(5) = 2: fdata(5) = strXref 'removes xref blocks
ftype(6) = -4: fdata(6) = "NOT>"
If Err.Number 0 Then
Set sset = ThisDrawing.SelectionSets.Item("ssblock")
End If
sset.Clear
selection:
sset.SelectOnScreen ftype, fdata
''no block found
If sset.count = 0 Then
response = MsgBox("No block found", vbRetryCancel, "NishCAD")
Select Case response
Case vbRetry
GoTo selection
Case vbCancel
GoTo ending
End Select
''list calculation
Else
count = sset.count
i = 1
For Index = 0 To count - 1
If sset.Item(Index).ObjectName = "AcDbBlockReference" Then
j = 2
FoundBlock = False
While j <= i
If myblkarray(0, j) = sset.Item(Index).EffectiveName Then
myblkarray(1, j) = myblkarray(1, j) + 1
j = i
FoundBlock = True
End If
j = j + 1
Wend
If Not FoundBlock Then
i = i + 1
ReDim Preserve myblkarray(2, i)
myblkarray(0, i) = sset.Item(Index).EffectiveName
myblkarray(1, i) = 1
End If
End If
Next Index
End If
''userform display
userform1.ListBox1.ColumnCount = 2
userform1.ListBox1.ColumnWidths = "100;30"
myblkarray(0, 0) = "BLOCK NAME"
myblkarray(1, 0) = "COUNT(S)"
userform1.ListBox1.Column() = myblkarray
userform1.Show
ending:
sset.delete
End Sub
i did not change anything after i installed 2006.so it should be i think same with other installed 2006.
i have microsoft listbox 2.0 checked in additional controls...
in references only first 7 controls r checked.
i will have to check this settings with other 2006's
how can i get these settings set thru vba?
