Hi Ershad,
Instead of testing every object in the drawing make a selection set of
the block references by using the GetUserSelectedObjects function below.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hand Select objects of a nominated type
' Status: Functional
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetUserSelectedObjects(ssObs As AcadSelectionSet,
spObjectType As String) As Long
On Error Resume Next
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant
Dim sNumber As String
FilterType(0) = 0: FilterData(0) = spObjectType
' The line below will create an error if the SSET doesn't exist
' or delete it if it does exist.
' The ON Error will allow the program to continue and create the set
ThisDrawing.SelectionSets.Item("SSET").Delete
If Err > 0 Then Err.Clear
On Error GoTo ErrorHandler
Set ssObs = ThisDrawing.SelectionSets.Add("SSET")
ssObs.SelectOnScreen FilterType, FilterData
GetUserSelectedObjects = ssObs.Count
Exit Function
ErrorHandler:
Err.Clear
GetUserSelectedObjects = 0
End Function ' GetUserSelectedObjects()
Call in with code like:
Dim ssBlocks As AcadSelectionSet
Dim ssPolies As AcadSelectionSet
dim l as Long
Dim lPolies as Long
l = GetUserSelectedObjects (ssBlocks, "INSERT")
lPolies = GetUserSelectedObjects (ssPolies , "LWPOLYLINE")
Then use code like:
Dim oRef as AcadBlockReference
Dim oPoly as AcadLWPolyline
Dim v as Variant
If l > 0 And lPolies > 0 then
For Each oRef in ss
For Each oPoly in ssPolies
v = oRef.IntersectWith(oPoly, acExtendNone)
If UBound(v) > -1 Then
' Do your thing
End if
Next
Next
end If
From some limited testing I've done with the
"BlockReference.IntersectWith" API, it appears uses the bounding box of
the block reference as it's checking mechanism so that you will get a
result showing where the polyline intersects the bounding box of the
block reference. The polyline need not actually intersect any of the
drafting of the block reference.
Regards
Laurie Comerford
Ershad.shaikh wrote:
> Using following code i am getting all the list of block's. And now i
> want to check block's, it is intersected with any line or not? plz tell
> me how to check this block is intersect or not ? Dim ssobjs As
> AcadEntity For Each ssobjs In ThisDrawing.ModelSpace If
> ssobjs.ObjectName = "AcDbBlockReference" Then ' Here I want to check
> this Adbclockreference is intersect with any line 'How to do this stuff?
> End If Next
