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.
Code:
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