VBNET AutoCAD Activex 切换图层为当前图层失效

最近有朋友询问切换图层的代码

com切换图层

 

<CommandMethod("mycl")>
    Public Sub MySubLayerChange()
        Dim Thisdrawing As Autodesk.AutoCAD.Interop.AcadDocument = Application.DocumentManager.MdiActiveDocument.AcadDocument
        Dim curLayer As Autodesk.AutoCAD.Interop.Common.AcadLayer = Thisdrawing.ActiveLayer
        Dim newLayer As Autodesk.AutoCAD.Interop.Common.AcadLayer
        For Each la As Autodesk.AutoCAD.Interop.Common.AcadLayer In Thisdrawing.Layers
            If la.Name = "layer1" Then
                newLayer = la
                Thisdrawing.ActiveLayer = newLayer
            End If
        Next

    End Sub

 

示效的话用下面的代码，切换系统变量

 

Public Sub ChangeLayer(ByRef LayerName As String)

        Acadapp.ActiveDocument.SetVariable("Clayer", LayerName)
        Acadapp.ActiveDocument.SetVariable("CELTYPE", "Bylayer")

        'For Each entry As Object In Acadapp.ActiveDocument.layers
        '    If entry.name = LayerName Then
        '        Acadapp.ActiveDocument.Activelayer = entry
        '        Exit For
        '    End If
        'Next entry

        ''改变线型
        'For Each entry As Object In Acadapp.ActiveDocument.Linetypes
        '    If entry.name = "Bylayer" Then
        '        Acadapp.ActiveDocument.ActiveLinetype = entry
        '        Exit For
        '    End If
        'Next

    End Sub
    '改变标注样式 //20190606 nan sheng modify 
    Public Sub ChangeDimStyles(ByRef Name As String)
        Acadapp.ActiveDocument.SendCommand("-dimstyle" & vbCr & "r" & vbCr & Name & vbCr) REM "_zoom" & vbCr & "a" & vbCr
        'ThisDrawing.SendCommand ("-dimstyle" & vbCr & "r" & vbCr & "111" & vbCr)
        'For Each entry As Object In Acadapp.ActiveDocument.DimStyles
        '    If entry.name = Name Then
        '        Acadapp.ActiveDocument.ActiveDimStyle = entry
        '        Exit For
        '    End If
        'Next entry
    End Sub

    '改变文字样式//20190606 nan sheng modify 
    Public Sub ChangeTextStyles(ByRef Name As String)
        Acadapp.ActiveDocument.SetVariable("TEXTSTYLE", Name)
        'For Each entry As Object In Acadapp.ActiveDocument.TextStyles
        '    If entry.name = Name Then
        '        Acadapp.ActiveDocument.ActiveTextStyle = entry
        '        Exit For
        '    End If
        'Next entry
    End Sub

---

 

NetApi切换图层

 

<CommandMethod("myclNetApi")>
    Public Sub MySubLayerChangeNetApi()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
            If lt.Has("layer1") Then
                db.Clayer = lt("layer1")
            End If
            trans.Commit()
        End Using

    End Sub