0 Members and 1 Guest are viewing this topic.
Private Function GetClipBoundary(ByVal ed As Editor) As ObjectId Dim peo = New PromptEntityOptions(vbLf & "Select boundary Polyline: ") peo.SetRejectMessage(vbLf & "Requires a closed, Polyline") peo.AddAllowedClass(GetType(Polyline), False) peo.AllowObjectOnLockedLayer = True peo.AllowNone = True Dim per = ed.GetEntity(peo) If per.Status <> PromptStatus.OK Then Return ObjectId.Null Using tr = New OpenCloseTransaction() Try Dim Lina As Polyline = CType(tr.GetObject(per.ObjectId, OpenMode.ForRead), Polyline) If Not (Lina.Closed AndAlso Lina.IsPlanar) Then ed.WriteMessage(vbLf & "Invalid selection, requires a closed, planar curve 2222.") Return ObjectId.Null End If Return per.ObjectId Finally tr.Commit() End Try End Using End Function Private Function GetObjectsToClip(ByVal ed As Editor) As SelectionSet Dim pso As PromptSelectionOptions = New PromptSelectionOptions() pso.RejectObjectsFromNonCurrentSpace = True pso.RejectObjectsOnLockedLayers = True Dim filter = New SelectionFilter({New TypedValue(0, "LINE,ARC,CIRCLE,SPLINE,LWPOLYLINE,ELLIPSE,INSERT,MTEXT,TEXT,POINT")}) Dim psr = ed.GetSelection(pso, filter) Return If(psr.Status = PromptStatus.OK, psr.Value, Nothing) End Function <CommandMethod("CUTOUTSIDE")> Sub ClipObjectsCommand2() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim ed As Editor = doc.Editor Dim db As Database = doc.Database Dim boundaryId As ObjectId = GetClipBoundary(ed) If boundaryId.IsNull Then Return Dim selection As SelectionSet = GetObjectsToClip(ed) If selection Is Nothing Then Return Try Using tr As Transaction = doc.TransactionManager.StartTransaction() Dim boundary As Polyline = CType(tr.GetObject(boundaryId, OpenMode.ForRead), Polyline) Dim btr = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) For Each id As ObjectId In selection.GetObjectIds() If id <> boundaryId Then Using trimmer As Autodesk.AutoCAD.ExportLayout.Trimmer = New Autodesk.AutoCAD.ExportLayout.Trimmer() Dim entityToTrim As Entity = CType(tr.GetObject(id, OpenMode.ForWrite), Entity) trimmer.Trim(entityToTrim, boundary) If trimmer.HasAccurateResults Then For Each ent As Entity In trimmer.TrimResultObjects ent.SetPropertiesFrom(entityToTrim) btr.AppendEntity(ent) tr.AddNewlyCreatedDBObject(ent, True) Next If trimmer.EntityCompletelyOutside OrElse trimmer.EntityOnBoundary Then entityToTrim.[Erase]() End If End Using End If Next tr.Commit() End Using Catch ex As System.Exception ed.WriteMessage(vbLf & "Operation failed ({0})", ex.Message) End Try End Sub