Community
@rmcefr Sorry to reply again
just for example here a simply code for selecting Polyline 1, Polyline 2 and got the two intersection points.
As you can see the variable intPoints, will contain intersection coordinates.
So you reach at least an half of your issue 🤣
Sub TestPline()
Dim intPoints As Variant
Dim P1 As AcadLWPolyline
Dim P2 As AcadLWPolyline
ThisDrawing.Utility.GetEntity P1, basePnt, "Select 1st PolyLine"
ThisDrawing.Utility.GetEntity P2, basePnt, "Select 2nd PolyLine"
intPoints = P1.IntersectWith(P2, acExtendNone)
End Sub
@rmcefr wrote:
but in this case we need to delete our main polylines, and keep only the added regions and that will let us to loose a lot of tools works normally with polylines,
In order to write a program to fully automate it, you need to define what identifies pl1 and pl2, and in this case it has you have many pl1's and many pl2's. That may not be easy. A user can look at it and apply some logic to decide and filter everything else out. In this case, we can't write code for this until you can tell us what logic to use. Perhaps you can add some unique property to pl1 and pl2 when you create them.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Here's a command I wrote that trims a line around blocks(schematic symbols) that are placed on it. It calls many other subs. If this looks like something you can use, I'll post the other subs.
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 -2147352567
If GetAsyncKeyState(VK_ESCAPE) And &H8000 > 0 Then
Err.Clear
Resume Exit_Here
ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
Err.Clear
Resume
End If
' Case -2145320928
' 'User input is keyword or..
' 'Right click
' Err.Clear
' Resume Exit_Here
Case Else
MsgBox Err.Description
Resume Exit_Here
End Select
End SubEd
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Hi, I need some thing like this, some how in reverse!
I tried to run the code. I get These errors:
1)User-defined type... in this line
Dim BBpoints(0 To 4) As Point and the next line. I changed the type to Variant which let the error go away.
2) on error handling...
GetAsyncKeyState(VK_ESCAPE)
GetAsyncKeyState(VK_LBUTTON)I don't know much about it so I replaced it with 1>0
3) at last I get "Object required" error.
I want to deal with this code before posting a new topic because it is really close to what I need. I appreciate your kind help!
This is syntax error with the last 2 lines: they should be:
Main_Polyline1_Region.Boolean AcBooleanType.acSubtraction, Main_Polyline_Region
Main_Polyline1.DeleteThat is, with VBA, you do not use brackets with subroutines, unless you place "Call " in front of it, like this:
Call Main_Polyline1_Region.Boolean(AcBooleanType.acSubtraction, Main_Polyline_Region)
If it is Function that returns some value, then you must use bracket:
Dim num As Integer
num=MyAddingFunction(1, 2)
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
