LwPolyline - Edit ConstantWidth

[jan_tappenbeck]

Hi !

i want to read the ConstantWidth of a lwpolyline and add a additional width.

the problem is, that the program frozze, when "polyline.ConstantWidth = newWidth"!!

any idea?

the code:

Public Function LayerAddLineWidth(ByVal LayerFilter As String,
                                  ByVal AddLineWidth As Double,
                                  Optional Log As EBL.Logger.Log = Nothing,
                                  Optional ByRef Execute As Boolean = True) As Boolean

    AcReInit()
    Dim Obj2Modify As ObjectIdCollection
    Obj2Modify = GetEntitiesOnLayer(LayerFilter, Elementtyp:="LWPOLYLINE")

    Dim InfoMsg As String = ""

    If Obj2Modify.Count = 0 Then
        If IsNothing(Log) Then
            _Editor.WriteMessage(InfoMsg & vbCrLf)
        Else
            Log.Write(InfoMsg)
        End If
        Return True
    End If

    InfoMsg = "Anzahl gefilterter Objekte: " & Obj2Modify.Count.ToString & vbCrLf
    If IsNothing(Log) Then
        _Editor.WriteMessage(InfoMsg & vbCrLf)
    Else
        Log.Write(InfoMsg)
    End If

    Try
        Using _AcDocument.LockDocument

            Using tr As Transaction = _Database.TransactionManager.StartTransaction()

                If Execute = True Then
                    For i As Integer = 0 To Obj2Modify.Count - 1
                        Try

                            'Dim text = tr.GetObject(Obj2Modify(i), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite)
                            Dim ent As Entity = CType(tr.GetObject(Obj2Modify(i), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), Entity)
                            Dim polyline As Autodesk.AutoCAD.DatabaseServices.Polyline = CType(ent, Autodesk.AutoCAD.DatabaseServices.Polyline)

                            ' Linienbreite auslesen
                            Dim currentWidth As Double = polyline.ConstantWidth

                            ' Linienbreite bestimmen
                            Dim newWidth As Double = currentWidth + AddLineWidth
                            polyline.ConstantWidth = newWidth


                        Catch ex As Exception
                            Dim ErrMsg As String = "unerwarteter Fehler in EBL.Service > Acad > LayerAddLineWidth - Loop" & vbCrLf &
                                   "AddLineWidth:= " & AddLineWidth.ToString("0.000") & vbCrLf &
                                   LogStatus4TryCatch(Log) &
                                   "Execute:= " & Execute.ToString & vbCrLf &
                                    ex.ToString()
                            If Not IsNothing(Log) Then
                                Log.Write(ErrMsg)
                            End If
                            Return False
                        End Try

                    Next i

                    tr.Commit()
                Else
                    _Editor.WriteMessage("** Befehlssimulation **" & vbCrLf)
                End If

            End Using 'Transaction
        End Using ' LockDocument


    Catch ex As Exception
        Dim ErrMsg As String = "unerwarteter Fehler in EBL.Service > Acad > LayerAddLineWidth" & vbCrLf &
            "AddLineWidth:= " & AddLineWidth.ToString("0.000") & vbCrLf &
                           LogStatus4TryCatch(Log) &
                    "Execute:= " & Execute.ToString & vbCrLf &
        ex.ToString()

        If Not IsNothing(Log) Then
            Log.Write(ErrMsg)
        End If
        Return False
    End Try

    Return True
End Function

    Public Function GetEntitiesOnLayer(LayerName As String,
                                       Optional Elementtyp As String = "",
                                       Optional TextHeight As Double = -1,
                                       Optional ByRef Log As EBL.Logger.Log = Nothing) As ObjectIdCollection
        ' https://gis-wiki.local.ebhl.de/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
        AcReInit()

        ' Build a filter list so that only entities
        ' on the specified layer are selected
        Try
            Dim tvs = New List(Of TypedValue) From {
                New TypedValue(CInt(DxfCode.LayerName), LayerName)
            }

            '  Dim tvs As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.LayerName), layerName)}
            If Elementtyp.Length > 0 Then tvs.Add(New TypedValue(CInt(DxfCode.Start), Elementtyp))
            If TextHeight > 0 Then tvs.Add(New TypedValue(CInt(DxfCode.TxtSize), TextHeight))

            _Editor.WriteMessage("Filterdefinition:= ")
            For i As Integer = 0 To tvs.Count - 1
                _Editor.WriteMessage("(" & tvs(i).TypeCode.ToString & ", " & tvs(i).Value.ToString & ")")
            Next 'i
            _Editor.WriteMessage(vbCrLf)

            Dim sf As New SelectionFilter(tvs.ToArray)
            Dim psr As PromptSelectionResult = _Editor.SelectAll(sf)

            If psr.Status = PromptStatus.OK Then
                Return New ObjectIdCollection(psr.Value.GetObjectIds())
            Else
                Return Nothing
            End If

        Catch ex As Exception
            Dim ErrMsg As String = "unerwarteter Fehler in EBL.Service > cls_Acad > GetEntitiesOnLayer" & vbCrLf & ex.ToString

            If Not IsNothing(Log) Then
                Log.WriteAsError(ErrMsg)
            Else
                _Editor.WriteMessage(ErrMsg & vbCrLf)
            End If
        End Try
        Return Nothing
    End Function

regards jan

[jan_tappenbeck]

i look over the border and following code will work.

    Public Sub YYLayerAddLineWidth(ByVal LayerFilter As String,
                                      ByVal AddLineWidth As Double,
                                      Optional Log As EBL.Logger.Log = Nothing,
                                      Optional ByRef Execute As Boolean = True)

        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor

        ' Auswahl der LWPolylinien
        Dim selectionPrompt As PromptSelectionOptions = New PromptSelectionOptions()
        selectionPrompt.MessageForAdding = "Wählen Sie die LWPolylinien aus:"
        Dim selectionResult As PromptSelectionResult = ed.GetSelection(selectionPrompt)

        If selectionResult.Status <> PromptStatus.OK Then
            Exit Sub
        End If

        ' Durchlaufen der ausgewählten Objekte
        Using trans As Transaction = doc.Database.TransactionManager.StartTransaction()
            For Each id As ObjectId In selectionResult.Value.GetObjectIds()
                Dim entity As Entity = TryCast(trans.GetObject(id, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), Entity)
                If TypeOf entity Is Autodesk.AutoCAD.DatabaseServices.Polyline Then
                    Dim polyline As Autodesk.AutoCAD.DatabaseServices.Polyline = CType(entity, Autodesk.AutoCAD.DatabaseServices.Polyline)
                    If polyline.NumberOfVertices > 0 Then
                        ' Setzen der globalen Linienbreite
                        Dim old As Double = polyline.ConstantWidth
                        polyline.ConstantWidth = old * 2
                    End If
                End If
            Next
            trans.Commit()
        End Using

        ed.WriteMessage(vbLf & "Die Linienbreite wurde für die ausgewählten LWPolylinien festgelegt.")
    End Sub

so i think the reason will be in acessing the polyline-entitiy.

regards Jan