Hi All
I need to check if the point inside or outside the polyline.
I know that many posts talked about this, but i did not found a real result till now.
Now i am trying with a peace of code that using TraceBoundary method, when user select a point inside an object, the boject color changed, the problem that i can not select the polylines only from other objects.
any help please, it very important for me.
Thanks
This my try.
Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Runtime.Interop Imports Autodesk.AutoCAD.BoundaryRepresentation Imports System.Collections.Generic Imports System.Linq Imports System.Text Imports ErrorStatus = Autodesk.AutoCAD.Runtime.ErrorStatus Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application Imports Autodesk.AutoCAD.ApplicationServices.DocumentExtension <CommandMethod("TB")> _ Public Sub TraceBoundary() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor ' Select a seed point for our boundary Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select internal point: ") If ppr.Status <> PromptStatus.OK Then Return End If ' Get the objects making up our boundary Dim objs As DBObjectCollection = ed.TraceBoundary(ppr.Value, True) If objs.Count > 0 Then Dim tr As Transaction = doc.TransactionManager.StartTransaction() Using tr ' We'll add the objects to the model space Dim bt As BlockTable = DirectCast(tr.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable) Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord) ' Add our boundary objects to the drawing and ' collect their ObjectIds for later use Dim ids As New ObjectIdCollection() For Each obj As DBObject In objs 'If TypeOf obj Is Polyline Then ' MsgBox("Yes") 'End If Dim ent As Entity = TryCast(obj, Entity) If ent IsNot Nothing Then ' Set our boundary objects to be of ' our auto-incremented colour index ent.ColorIndex = _index ' Set the lineweight of our object ent.LineWeight = LineWeight.LineWeight050 ' Add each boundary object to the modelspace ' and add its ID to a collection ids.Add(btr.AppendEntity(ent)) tr.AddNewlyCreatedDBObject(ent, True) End If Next ' Increment our colour index _index += 1 ' Commit the transaction tr.Commit() End Using End If End Sub
Solved! Go to Solution.
Solved by AubelecBE. Go to Solution.
Hi,
Do you want to consider polylines only as boundary objects ? If the entities other than polylines are in different layers, switch off those layers first and then trace the boundary.
Regards,
gsktry
Thank you gsktry
At the same time i need to get areas of polylines, if i consider polylines only as boundary objects, can i get the area also or no.
if the answer is yes, how to do this in code if you can please because i am new in this field.
Thank you very much
I don't have any existing code. But my suggestion is here:
Your existing code creates the polyline and adds it to the model. So, you can get the area of the created polyline as shown below.
If TypeOf (ent) Is Polyline Then Dim pl As Polyline pl = DirectCast(ent, Polyline) If pl.Closed Then MsgBox(pl.Area) End If End If
Regards,
gsktry
Here my function for detect if a blockreference is inside of a polyline :
'*********************************************************************** '** procedure de détection si un point est dans une région(polyline) ** '*********************************************************************** '** ENTREE : ** '** - Ligne : la polyline ** '** Attention vérifier avant que la polyligne ne se ** '** croise pas elle-même (IsPolylineSelfIntercept) ** '** - Bloc : Le bloc a tester ** '** SORTIE : ** '** - True si dedans sinon false ** '*********************************************************************** Public Function IsBlocInZoneFromPolyline(ByRef Bloc As BlockReference, ByRef Ligne As Polyline) As Boolean Dim OkRetour As Boolean = False '=========================================================================== 'Gestion des erreurs d'entrée : 'Si pas définit If IsNothing(Bloc) = True Or IsNothing(Ligne) = True Then Return OkRetour 'Si ligne non fermée If Ligne.Closed = False Then Return False '=========================================================================== '=========================================================================== 'génération des points d'entrée de la fonction de calcul + vérification simple 'du point de test Dim pt As New Point2d(Bloc.Position.X, Bloc.Position.Y) ' si le point est sur la polyligne Dim vn As Integer = Ligne.NumberOfVertices Dim colpt() As Point2d = Nothing ReDim colpt(vn) For i As Integer = 0 To vn - 1 '// Could also get the 3D point here Dim pts As Point2d = Ligne.GetPoint2dAt(i) colpt(i) = New Point2d(pts.X, pts.Y) 'Test si le point est sur un segment de la polyline si oui exit ! Dim seg As Curve2d = Nothing Dim segType As SegmentType = Ligne.GetSegmentType(i) If (segType = SegmentType.Arc) Then seg = Ligne.GetArcSegment2dAt(i) ElseIf (segType = SegmentType.Line) Then seg = Ligne.GetLineSegment2dAt (i) End If If IsNothing(seg) = False Then OkRetour = seg.IsOn(pt) If OkRetour = True Then Return True End If End If Next 'ajout du point [0] pour finir la boucle ! colpt(vn) = Ligne.GetPoint2dAt(0) '=========================================================================== Dim RetFonction As Double RetFonction = wn_PnPoly(pt, colpt, vn) If RetFonction = 0 Then OkRetour = False Else OkRetour = True End If Return OkRetour End Function '************************************************************************************** '// Copyright 2000 softSurfer, 2012 Dan Sunday '// This code may be freely used and modified for any purpose '// providing that this copyright notice is included with it. '// SoftSurfer makes no warranty for this code, and cannot be held '// liable for any real or imagined damage resulting from its use. '// Users of this code must verify correctness for their application. '************************************************************************************** 'isLeft(): tests if a point is Left|On|Right of an infinite line. '// Input: three points P0, P1, and P2 '// Return: >0 for P2 left of the line through P0 and P1 '// =0 for P2 on the line '// <0 for P2 right of the line '// See: Algorithm 1 "Area of Triangles and Polygons" Private Function isLeft(ByVal P0 As Point2d, ByVal P1 As Point2d, ByVal P2 As Point2d) As Double Return ((P1.X - P0.X) * (P2.Y - P0.Y) - (P2.X - P0.X) * (P1.Y - P0.Y)) End Function '************************************************************************************** '************************************************************************************** '// wn_PnPoly(): winding number test for a point in a polygon '// Input: P = a point, '// V[] = vertex points of a polygon V[n+1] with V[n]=V[0] '// Return: wn = the winding number (=0 only when P is outside) 'int Private Function wn_PnPoly(ByVal P As Point2d, ByVal V() As Point2d, ByVal n As Double) As Double Dim wn As Double = 0 '// the winding number counter '// loop through all edges of the polygon For i As Integer = 0 To n - 1 'for (int i=0; i<n; i++) { If (V(i).Y <= P.Y) Then '// edge from V[i] to V[i+1] '// start y <= P.y If (V(i + 1).Y > P.Y) Then '// an upward crossing If (isLeft(V(i), V(i + 1), P) > 0) Then '// P left of edge wn = wn + 1 '// have a valid up intersect End If End If Else '// start y > P.y (no test needed) If (V(i + 1).Y <= P.Y) Then '// a downward crossing If (isLeft(V(i), V(i + 1), P) < 0) Then '// P right of edge wn = wn - 1 '// have a valid down intersect End If End If End If Next Return wn End Function '**************************************************************************************
1 - Public Function IsBlocInZoneFromPolyline(ByRef Bloc As BlockReference, ByRef Ligne As Polyline) As Boolean
--> return true if the Pt of Block is inside of the Ligne
2 - Private Function wn_PnPoly(ByVal P As Point2d, ByVal V() As Point2d, ByVal n As Double) As Double
It is not my function but i have found in on the net.
3 -Private Function isLeft(ByVal P0 As Point2d, ByVal P1 As Point2d, ByVal P2 As Point2d) As Double
used in the wn_pnpoly
with this you can détect a point inside a poly or not.
++
Hello AubelecBE
This My try with your code.
<CommandMethod("xCatchArchAreas")> _ Public Sub xCatchArchAreas() Dim myDB As Database = HostApplicationServices.WorkingDatabase Using myTrans As Transaction = myDB.TransactionManager.StartTransaction Dim myBlockTable As BlockTable = myDB.BlockTableId.GetObject(OpenMode.ForRead) Dim myModelSpace As BlockTableRecord = myBlockTable(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead) For Each myObjectID As ObjectId In myModelSpace Dim myEntity As Entity = myObjectID.GetObject(OpenMode.ForRead) If TypeOf myEntity Is Polyline Then zzCatchArchAreas(myEntity) End If Next myTrans.Abort() End Using End Sub <CommandMethod("zzCatchArchAreas")> _ Public Sub zzCatchArchAreas(pl As Polyline) Dim myDB As Database = HostApplicationServices.WorkingDatabase Using myTrans As Transaction = myDB.TransactionManager.StartTransaction Dim myBlockTable As BlockTable = myDB.BlockTableId.GetObject(OpenMode.ForRead) Dim myModelSpace As BlockTableRecord = myBlockTable(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead) For Each myObjectID As ObjectId In myModelSpace Dim myEntity As Entity = myObjectID.GetObject(OpenMode.ForRead) Dim mybool As Boolean If TypeOf myEntity Is BlockReference Then mybool = IsBlocInZoneFromPolyline(myEntity, pl) MsgBox(mybool) End If Next myTrans.Abort() End Using End Sub Public Function IsBlocInZoneFromPolyline(ByRef Bloc As BlockReference, ByRef Ligne As Polyline) As Boolean Dim OkRetour As Boolean = False If IsNothing(Bloc) = True Or IsNothing(Ligne) = True Then Return OkRetour If Ligne.Closed = False Then Return False Dim pt As New Point2d(Bloc.Position.X, Bloc.Position.Y) Dim vn As Integer = Ligne.NumberOfVertices Dim colpt() As Point2d = Nothing ReDim colpt(vn) For i As Integer = 0 To vn - 1 Dim pts As Point2d = Ligne.GetPoint2dAt(i) colpt(i) = New Point2d(pts.X, pts.Y) Dim seg As Curve2d = Nothing Dim segType As SegmentType = Ligne.GetSegmentType(i) If (segType = SegmentType.Arc) Then seg = Ligne.GetArcSegment2dAt(i) ElseIf (segType = SegmentType.Line) Then seg = Ligne.GetLineSegment2dAt(i) End If If IsNothing(seg) = False Then OkRetour = seg.IsOn(pt) If OkRetour = True Then Return True End If End If Next colpt(vn) = Ligne.GetPoint2dAt(0) Dim RetFonction As Double RetFonction = wn_PnPoly(pt, colpt, vn) If RetFonction = 0 Then OkRetour = False Else OkRetour = True End If Return OkRetour End Function Private Function isLeft(ByVal P0 As Point2d, ByVal P1 As Point2d, ByVal P2 As Point2d) As Double Return ((P1.X - P0.X) * (P2.Y - P0.Y) - (P2.X - P0.X) * (P1.Y - P0.Y)) End Function Private Function wn_PnPoly(ByVal P As Point2d, ByVal V() As Point2d, ByVal n As Double) As Double Dim wn As Double = 0 For i As Integer = 0 To n - 1 If (V(i).Y <= P.Y) Then If (V(i + 1).Y > P.Y) Then If (isLeft(V(i), V(i + 1), P) > 0) Then wn = wn + 1 End If End If Else If (V(i + 1).Y <= P.Y) Then If (isLeft(V(i), V(i + 1), P) < 0) Then wn = wn - 1 End If End If End If Next Return wn End Function
Hi. i have copy past your code but i have del the second commandmethode
it is work for me on acad2015. i have tryed ucs and ucg. i have false and tru for the second.
here my file of test.
I dont use 3D only 2d. (architectural plan for my job. (electrical plan))
Hi,
You can see this thread where two ways are provided to check if a point is inside a polyline: one using a MPolygon object which have a IsPointInsideMPolygon() method and another one (by Tony Tanzillo) using a Region and the BoundaryRepresentation (Brep) API. In both cases, it's easy to create a MPolygon or a Region from a closed Polyline.