Author Topic: Change layer of the selected objects to the target object layer  (Read 792 times)

0 Members and 1 Guest are viewing this topic.

Offline fixo

  • Full Member
  • ***
  • Posts: 135
  • Karma: +4/-0
  • Gender: Male
    • prefered language: C
    • Prog expertise: Good
    • View Profile
Change layer of the selected objects to the target object layer
« on: February 17, 2012, 08:55:05 PM »
Code: [Select]
        <CommandMethod("MatchLayersByTarget", "MHL", CommandFlags.Modal Or CommandFlags.Transparent)> _
        Public Sub MatchLayerTest()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim how As Boolean = False
            Dim pso As PromptSelectionOptions = New PromptSelectionOptions()
            pso.MessageForRemoval = vbLf & "Nothing selected, please try again: "
            pso.MessageForAdding = vbLf & "Select objects to be changed"

            Dim psr As PromptSelectionResult = ed.GetSelection(pso)
            If psr.Status <> PromptStatus.OK Then
                Return
            End If

            Dim peo As New PromptEntityOptions(vbLf & "Select an object on the target layer: ")
            peo.AllowObjectOnLockedLayer = True

            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status <> PromptStatus.OK Then
                Return
            End If
            Try
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Dim ent As Entity = TryCast(tr.GetObject(per.ObjectId, OpenMode.ForRead), Entity)
                    If ent Is Nothing Then
                        Return
                    End If
                    Dim lt As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
                    Dim ltrIds As New ObjectIdCollection
                    Dim lname As String = ent.Layer
                    Dim lid As ObjectId = lt(lname)
                    Dim ltr As LayerTableRecord = TryCast(tr.GetObject(lid, OpenMode.ForWrite), LayerTableRecord)
                    If ltr.IsLocked Then
                        ltr.IsLocked = False
                        If Not ltrIds.Contains(lid) Then ltrIds.Add(lid)
                    End If
                    Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)


                    For Each selobj As SelectedObject In psr.Value
                        Dim sent As Entity = TryCast(tr.GetObject(selobj.ObjectId, OpenMode.ForRead), Entity)
                        If sent IsNot Nothing Then
                            sent.UpgradeOpen()

                            lid = lt(sent.Layer)
                            ltr = TryCast(tr.GetObject(lid, OpenMode.ForWrite), LayerTableRecord)
                            If ltr.IsLocked Then
                                ltr.IsLocked = False
                                If Not ltrIds.Contains(lid) Then ltrIds.Add(lid)
                            End If
                            sent.Layer = lname
                            sent.DowngradeOpen()
                        End If
                    Next
                    ''restore layer states
                    For Each lid In ltrIds
                        ltr = TryCast(tr.GetObject(lid, OpenMode.ForWrite), LayerTableRecord)
                        If Not ltr.IsLocked Then
                            ltr.IsLocked = True
                        End If
                    Next
                    tr.Commit()
                End Using
                how = True
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                ed.WriteMessage(ex.Message)
                how = False
            Finally
                Dim result As String = "   ---   The program has ended up with " + IIf(how, "success", "bugs").ToString
                ed.WriteMessage(vbLf + result)
            End Try
        End Sub

~'J'~