Results 1 to 4 of 4

Thread: IntersectWith Question

  1. #1
    Active Member
    Join Date
    Login to Give a bone

    Default IntersectWith Question

    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)
        ' 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
            End If
    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.

  2. #2
    Administrator Ed Jobe's Avatar
    Join Date
    Turlock, CA
    Login to Give a bone

    Default Re: IntersectWith Question

    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
        '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")
            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
                        '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
                            'the startpoint is in the block
                            objLine.StartPoint = vSPoint1
                        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)
                                    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
                            Case Is = 1 'start point is inside
                                objLine.StartPoint = vEPoint1
                            Case Is = 2 'end point is inside
                                objLine.EndPoint = vSPoint1
                            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)
            Next iSE
        Next objBlock
        Exit Sub
        Select Case Err.Number
        Case Else
            MsgBox Err.Description
            Resume Exit_Here
        End Select
    End Sub
    C:> ED WORKING....

  3. #3
    Active Member
    Join Date
    Login to Give a bone

    Default Re: IntersectWith Question

    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.


  4. #4
    Administrator Ed Jobe's Avatar
    Join Date
    Turlock, CA
    Login to Give a bone

    Default Re: IntersectWith Question

    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 Function
        Select Case Err.Number
        'Add your Case selections here
        'Case Is = 1000
            'Handle error
            'Resume Exit_Here
        Case Else
            MsgBox Err.Number & ", " & Err.Description, , "XYZDistance"
            Resume Exit_Here
        End Select
    End Function
    C:> ED WORKING....

Similar Threads

  1. IntersectWith motod problem VBA
    By 4gokay372489 in forum VBA/COM Interop
    Replies: 1
    Last Post: 2013-02-06, 11:22 AM
  2. IntersectWith Problems
    By srperrier in forum Dot Net API
    Replies: 0
    Last Post: 2011-08-05, 08:07 PM
  3. IntersectWith says lines don't intersect
    By bsardeson in forum VBA/COM Interop
    Replies: 3
    Last Post: 2010-08-23, 08:09 PM
  4. Problems with IntersectWith
    By Lee Mac in forum AutoLISP
    Replies: 3
    Last Post: 2009-05-17, 11:20 PM
  5. Intersectwith issue
    By kerbocad in forum VBA/COM Interop
    Replies: 2
    Last Post: 2009-02-19, 03:27 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts