Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports System.ComponentModel
Imports System.Collections.Specialized
Imports System.Collections.ObjectModel
Imports System.Linq
<Assembly: CommandClass(GetType(tmpdel.MyCommands))>
<Assembly: ExtensionApplication(GetType(tmpdel.MyPlugin))>
Namespace tmpdel
Public Class MyPlugin
Implements IExtensionApplication
Public Sub Initialize() Implements IExtensionApplication.Initialize
End Sub
Public Sub Terminate() Implements IExtensionApplication.Terminate
End Sub
End Class
Public Class MyCommands
<CommandMethod("mytest2")> _
Public Sub MyCommand2()
showA(pickCurve) 'make sure you pick curve
End Sub
' this is found online test from one on developers. dont work well
'http://adndevblog.typepad.com/autocad/2012/05/how-to-detect-if-a-polyline-is-self-intersecting.html
<CommandMethod("SelfIntersectPline")> _
Public Shared Sub SelfIntersectPline()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim peo As New PromptEntityOptions(vbLf & "Select Polyline: ")
peo.SetRejectMessage(vbLf & "Must be a Polyline...")
peo.AddAllowedClass(GetType(Polyline), True)
Dim per As PromptEntityResult = ed.GetEntity(peo)
If per.Status <> PromptStatus.OK Then
Return
End If
Using Tx As Transaction = db.TransactionManager.StartTransaction()
Dim polyline As Polyline = TryCast(per.ObjectId.GetObject(OpenMode.ForRead), Polyline)
Dim entities As New DBObjectCollection()
polyline.Explode(entities)
For i As Integer = 0 To entities.Count - 1
For j As Integer = i + 1 To entities.Count - 1
Dim curve1 As Curve = TryCast(entities(i), Curve)
Dim curve2 As Curve = TryCast(entities(j), Curve)
Dim points As New Point3dCollection()
curve1.IntersectWith(curve2, Intersect.OnBothOperands, points, IntPtr.Zero, IntPtr.Zero)
For Each point As Point3d In points
' Make a check to skip the start/end points
' since they are connected vertices
If point = curve1.StartPoint OrElse point = curve1.EndPoint Then
If point = curve2.StartPoint OrElse point = curve2.EndPoint Then
' If two consecutive segments, then skip
If j = i + 1 Then
Continue For
End If
End If
End If
ed.WriteMessage(vbLf & " - Intersection point: " + point.ToString())
Next
Next
' Need to be disposed explicitely
' since entities are not DB resident
entities(i).Dispose()
Next
End Using
End Sub
'----------------------end of developers part
Public Shared Function GetAreaCom(curve As Curve) As Double
Dim pl = curve.AcadObject
Return DirectCast(pl.Area, Double)
End Function
Public Sub showA(oid As ObjectId)
Dim area As Double
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.GetDocument(db)
Using trans As OpenCloseTransaction = db.TransactionManager.StartOpenCloseTransaction()
Dim curve As Curve = trans.GetObject(oid, OpenMode.ForRead)
'polyline area shows wrong value for self intersected polyline, however COM shows right, but slower
If curve.GetRXClass.IsDerivedFrom(RXClass.GetClass(GetType(Xline))) Then
area = 0
Else
If curve.GetRXClass = RXClass.GetClass(GetType(Polyline)) Then
Dim cge As Curve3d = curve.GetGeCurve()
Dim ci As New CurveCurveIntersector3d(cge, cge, curve.GetPlane.Normal)
If ci.NumberOfIntersectionPoints() > 0 Or Not curve.Closed Then
MsgBox("self-intersect or not closed") area = GetAreaCom(curve)
Else
area = curve.Area
End If
'this would be nice, but dont work
'_area = cge.GetArea(curve.StartParam, curve.EndParam)
cge.Dispose()
ci.Dispose()
Else
area = curve.Area
End If
End If
trans.Commit()
End Using
End Sub
Public Function pickCurve() As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Application.DocumentManager.GetDocument(db)
Dim ed As Editor = doc.Editor
Dim peo As PromptEntityOptions = New PromptEntityOptions("Select a curve: ")
peo.SetRejectMessage("Selected object is not a curve.")
peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Curve), False)
Dim per As PromptEntityResult = ed.GetEntity(peo)
If per.Status = PromptStatus.OK Then
Return per.ObjectId
End If
End Function
End Class
End Namespace
