IntersectWith Question

[david.brissenden]

Hi guys,

I have a question regarding IntersectWith and blocks. I am writing a test piece of code to see whether I can get the points at which a line intersects a block. So far I have this:

Sub Example_IntersectWith()
' This example creates a line and circle and finds the points at
' which they intersect.

' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double

startPt(0) = 1709: startPt(1) = 908: startPt(2) = 0
endPt(0) = 1734: endPt(1) = 908: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)

ZoomExtents

' Find the intersection points between the line and the block
Dim intPoints As Variant
Dim blkCol As AcadBlocks
Dim abc As AcadBlock

' Get the Blocks collection
Set blkCol = ThisDrawing.Blocks

For Each abc In blkCol

intPoints = lineObj.IntersectWith(abc, acExtendNone)

' Print all the intersection points
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If

Next

End Sub


My first questionis this going to work? My second question is how do I fix it? Currently it stops here
intPoints = lineObj.IntersectWith(abc, acExtendNone) with an error of "Not an entity".

What I don't want to do is pile a load of time into this if it will never work.

Thanks for your help.

[Ed Jobe]

Try this code. The command breaks a line where a block intersects it. It is designed for doing schematics. The schematic block has to be based on a one inch grid and the block scale is used to assist in determining where to break the line.

Public Sub BreakLineByBlock()
'Break lines around block insertions.

Dim str As String
Dim strHandle As String
Dim objLine As AcadLine
Dim objLine1 As AcadLine
Dim objLine2 As AcadLine
Dim objSubEnt As AcadEntity
Dim objBlock As AcadBlockReference
Dim ssBlocks As AcadSelectionSet
Dim ssLines As AcadSelectionSet
Dim vSubEnts As Variant
Dim vMinPoint As Variant
Dim vMaxPoint As Variant
Dim vIntPoint As Variant
Dim vCPoint As Variant 'compare point
Dim vSPoint As Variant 'start point
Dim vSPoint1 As Variant 'start point prime
Dim vEPoint As Variant 'end point
Dim vEPoint1 As Variant 'end point prime
Dim dPickPoint(0 To 1) As Double
Dim dPoint(0 To 2) As Double
Dim dDistSP As Double 'shortest distance from start point
Dim dDistEP As Double 'shortest distance from end point
Dim dDistC As Double 'comparison distance
Dim dVertList(0 To 7) As Double
Dim iL As Integer 'lines counter
Dim iP As Integer 'points counter
Dim iSE As Integer 'sub entities counter
Dim iCntL As Integer 'line count
Dim iCntP As Integer 'point count
Dim iCntSE As Integer 'sub entity count
Dim PtsInsideBB As Integer '0=none: 1=StartPoint: 2=EndPoint
Dim varFilterType(0) As Integer
Dim varFilterData(0) As Variant
Dim vFT As Variant
Dim vFD As Variant
Dim BBpoints(0 To 4) As Point 'Bounding box points list
Dim Cpoint As Point 'compare point

On Error GoTo Err_Control
'Set up undo for this command
ThisDrawing.StartUndoMark
'get blocks
ThisDrawing.Utility.Prompt "Lines will be broken around selected blocks."
Set ssBlocks = toolbox.ejSelectionSets.GetSS_BlockFilter
For Each objBlock In ssBlocks
'Use the block's bounding box to select ents that intersect with it.
objBlock.GetBoundingBox vMinPoint, vMaxPoint
BBpoints(0).x = vMinPoint(0): BBpoints(0).y = vMinPoint(1)
BBpoints(1).x = vMaxPoint(0): BBpoints(1).y = vMinPoint(1)
BBpoints(2).x = vMaxPoint(0): BBpoints(2).y = vMaxPoint(1)
BBpoints(3).x = vMinPoint(0): BBpoints(3).y = vMaxPoint(1)
BBpoints(4).x = vMinPoint(0): BBpoints(4).y = vMinPoint(1)
Set ssLines = toolbox.ejSelectionSets.AddSelectionSet("ssLines")
ssLines.Clear
varFilterType(0) = 0: varFilterData(0) = "LINE"
vFT = varFilterType: vFD = varFilterData
ssLines.Select acSelectionSetCrossing, vMaxPoint, vMinPoint, vFT, vFD
'get subent's of block
vSubEnts = objBlock.Explode
iCntSE = UBound(vSubEnts)
For Each objLine In ssLines
'Compare subentity intersection points with line start and
'end points to determine new line segment. Points creating the
'shortest line segments should be the outer limits of the block.
'Any other intersections are inside the block and are discarded.
' Get reference info.
vSPoint = objLine.StartPoint
vEPoint = objLine.EndPoint
dDistSP = toolbox.ejMath.XYZDistance(vSPoint, vEPoint)
dDistEP = toolbox.ejMath.XYZDistance(vEPoint, vSPoint)
Cpoint.x = vSPoint(0): Cpoint.y = vSPoint(1)
If toolbox.ejMath.InsidePolygon(BBpoints, Cpoint) = True Then PtsInsideBB = PtsInsideBB Or 1
Cpoint.x = vEPoint(0): Cpoint.y = vEPoint(1)
If toolbox.ejMath.InsidePolygon(BBpoints, Cpoint) = True Then PtsInsideBB = PtsInsideBB Or 2
For iSE = 0 To iCntSE
'get list of points where the line intersects with the block
Set objSubEnt = vSubEnts(iSE)
vIntPoint = objSubEnt.IntersectWith(objLine, acExtendNone)
'Compare to line segment lengths.
If UBound(vIntPoint) > -1 Then
iCntP = (UBound(vIntPoint) + 1) / 3
For iP = 1 To iCntP
vCPoint = toolbox.ejMath.Point3D((vIntPoint(iP * 3 - 3)), (vIntPoint(iP * 3 - 2)), (vIntPoint(iP * 3 - 1)))
dDistC = toolbox.ejMath.XYZDistance(vSPoint, vCPoint)
If dDistC < dDistSP Then
dDistSP = dDistC
vSPoint1 = vCPoint
End If
dDistC = toolbox.ejMath.XYZDistance(vCPoint, vEPoint)
If dDistC < dDistEP Then
dDistEP = dDistC
vEPoint1 = vCPoint
End If
Next iP
Else
'the array returned by IntersectWith is dimensioned
' (0 To -1) when there are no points.
End If
Next iSE
Select Case Round(objLine.Length, 14)
Case Is = Round(dDistSP, 14)
'line did not intersect the block
'do nothing
Case Is = Round(dDistSP + dDistEP, 14)
'One end of the line is inside the block and does
'not pass through, only one intersection point.
'Determine whether start point or end
'point is in the block and trim it. Assume the smaller
'distance is inside the block.
If dDistSP > dDistEP Then
'the endpoint is in the block
objLine.EndPoint = vEPoint1
objLine.Update
Else
'the startpoint is in the block
objLine.StartPoint = vSPoint1
objLine.Update
End If
Case Else
'enough intersection points exist to break the line
'create two new lines and delete the original
Select Case PtsInsideBB
Case Is = 0 'neither end is inside
If ThisDrawing.ActiveSpace = acModelSpace Then
Set objLine1 = ThisDrawing.ModelSpace.AddLine(vSPoint, vSPoint1)
Set objLine2 = ThisDrawing.ModelSpace.AddLine(vEPoint1, vEPoint)
Else
Set objLine1 = ThisDrawing.PaperSpace.AddLine(vSPoint, vSPoint1)
Set objLine2 = ThisDrawing.PaperSpace.AddLine(vEPoint1, vEPoint)
'update new lines so that they will be seen by the next attempt to
'get a selection set
End If
objLine1.Update
objLine2.Update
objLine.Delete
Case Is = 1 'start point is inside
objLine.StartPoint = vEPoint1
objLine.Update
Case Is = 2 'end point is inside
objLine.EndPoint = vSPoint1
objLine.Update
Case Is = 3 'both ends are inside
End Select
PtsInsideBB = 0 'reset for next line
End Select
Next objLine
For iSE = 0 To iCntSE
Set objSubEnt = vSubEnts(iSE)
objSubEnt.Delete
Next iSE
Next objBlock

Exit_Here:
ThisDrawing.EndUndoMark
Exit Sub

Err_Control:
Select Case Err.Number
Case Else
MsgBox Err.Description
Resume Exit_Here
End Select
End Sub

[david.brissenden]

Thanks for the help Ed. I am trying to find out the width of blocks as a line passes through it so it should help if I dissect it.

Cheers.

[Ed Jobe]

Sure, you can do that. This sub breaks a line at those two points. You just need to find the distance between those two points.


Public Function XYZDistance(Point1 As Variant, Point2 As Variant) As Double
On Error GoTo Err_Control
'Returns the distance between two points
Dim dblDist As Double
Dim dblXSl As Double
Dim dblYSl As Double
Dim dblZSl As Double
Dim varErr As Variant
On Error GoTo Err_Control
'Calc distance
dblXSl = (Point1(0) - Point2(0)) ^ 2
dblYSl = (Point1(1) - Point2(1)) ^ 2
dblZSl = (Point1(2) - Point2(2)) ^ 2
dblDist = Sqr(dblXSl + dblYSl + dblZSl)
'Return Distance
XYZDistance = dblDist
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
'Add your Case selections here
'Case Is = 1000
'Handle error
'Err.Clear
'Resume Exit_Here
Case Else
MsgBox Err.Number & ", " & Err.Description, , "XYZDistance"
Err.Clear
Resume Exit_Here
End Select
End Function