Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
hi !
i want to create a draworder-function with a subfunction to select object by layer-filter.
the function to select the elements is following:
Public Function GetEntitiesOnLayer(layerName As String) As ObjectIdCollection ' http://ma22-wiki-001/eblwiki/index.php?title=Acad_(Klasse_von_EBL.Service)#GetEntitiesOnLayer ' Quelle: http://through-the-interface.typepad.com/through_the_interface/2008/05/finding-all-the.html Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim ed As Editor = doc.Editor ' Build a filter list so that only entities ' on the specified layer are selected Dim tvs As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.LayerName), layerName)} Dim sf As New SelectionFilter(tvs) Dim psr As PromptSelectionResult = ed.SelectAll(sf) If psr.Status = PromptStatus.OK Then Return New ObjectIdCollection(psr.Value.GetObjectIds()) Else Return New ObjectIdCollection() End If End Function
the draworder-main function is:
''' <summary> ''' ändern der Zeichenreihenfolge - HINTERgrund ''' </summary> ''' <param name="LayerFilter">Filter für die Layernamen</param> ''' <param name="Log">optional byref Log (default:= LEERSTRING)</param> ''' <returns>true ... ok / false ....mit Fehler</returns> Public Function DrawOrderChangeToButtom(ByVal LayerFilter As String, Optional ByRef Log As String = "") As Boolean _Editor.WriteMessage("Objekte in den Hintergrund verschieben ...") DrawOrderChange_Work(LayerFilter, 0, Log) End Function ''' <summary> ''' ändern der Zeichenreihenfolge - VORDERgrund ''' </summary> ''' <param name="LayerFilter">Filter für die Layernamen</param> ''' <param name="Log">optional byref Log (default:= LEERSTRING)</param> ''' <returns>true ... ok / false ....mit Fehler</returns> Public Function DrawOrderChangeToTop(ByVal LayerFilter As String, Optional ByRef Log As String = "") As Boolean _Editor.WriteMessage("Objekte in den Vordergrund verschieben ...") DrawOrderChange_Work(LayerFilter, 1, Log) End Function ''' <summary> ''' ändern der Zeichenreihenfolge - Arbeitsfunktion ''' </summary> ''' <param name="LayerFilter">Filter für die Layernamen</param> ''' <param name="Status">0 .... 2Buttom / 1 ... 2Top</param> ''' <param name="Log">optional byref Log (default:= LEERSTRING)</param> ''' <returns>true ... ok / false ....mit Fehler</returns> Private Function DrawOrderChange_Work(ByVal LayerFilter As String, ByVal Status As Short, Optional ByRef Log As String = "") As Boolean AcReInit() Dim Obj2Move As ObjectIdCollection = GetEntitiesOnLayer(LayerFilter) Dim drawOrder As New SortedList(Of Long, ObjectId)() If LayerFilter.Length = 0 Then Log += "kein Layerfilter angegeben!" Return False End If Dim Msg As String = "keine Objekte gefiltert!" If Obj2Move.Count = 0 Then _Editor.WriteMessage(Msg) Log += Msg Return True End If Msg = "Anzahl gefilterter Objekte: " & Obj2Move.Count.ToString _Editor.WriteMessage(Msg) Log += Msg Try Using tr As Transaction = _Database.TransactionManager.StartTransaction() Dim bt As BlockTable = TryCast(tr.GetObject(_Database.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockTable) Dim btrModelSpace As BlockTableRecord = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockTableRecord) Dim dot As DrawOrderTable = TryCast(tr.GetObject(btrModelSpace.DrawOrderTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), DrawOrderTable) Dim objToMove As New ObjectIdCollection() ''For i As Integer = 0 To Obj2Move.Count - 1 '' objToMove.Add(Obj2Move(i)) ''Next i Select Case Status Case 0 dot.MoveToBottom(Obj2Move) Case 1 dot.MoveToTop(Obj2Move) End Select tr.Commit() End Using Catch ex As Exception Log += "unerwarteter Fehler in EBL.Service > Acad > DrawOrder" & vbCrLf & ex.ToString Return False End Try Return True End Function
the problem is to select the objects.
if i call GetEntitiesOnLayer by a text-call
<LispFunction("EBL_SEL")> _ Public Sub EBL_SEL(ByVal rbArgs As ResultBuffer) GetEntitiesOnLayer("Grün") End Sub
it works!
if i call the draworder-function there is in line
If psr.Status = PromptStatus.OK Then
of GetEntitiesOnLayer
psr.Status = Error {-5001}
could someone tell me why?
reagards Jan
Solved! Go to Solution.