Author Topic: Trim outside closed polyline  (Read 374 times)

0 Members and 1 Guest are viewing this topic.


  • Newt
  • Posts: 26
Trim outside closed polyline
« on: December 20, 2021, 04:22:54 PM »


I run into this sample and was try to use polyline not curve but nothing happened

Code: [Select]

      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()

                    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
                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

        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


                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
                                        tr.AddNewlyCreatedDBObject(ent, True)

                                    If trimmer.EntityCompletelyOutside OrElse trimmer.EntityOnBoundary Then entityToTrim.[Erase]()
                                End If
                            End Using
                        End If

                End Using

            Catch ex As System.Exception
                ed.WriteMessage(vbLf & "Operation failed ({0})", ex.Message)
            End Try
        End Sub