您的位置: 首页 > IT文章 > VBNET AutoCAD Activex 切换图层为当前图层失效

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

分类: IT文章 • 2022-08-31 16:09:35

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

com切换图层

 1 <CommandMethod("mycl")>
 2     Public Sub MySubLayerChange()
 3         Dim Thisdrawing As Autodesk.AutoCAD.Interop.AcadDocument = Application.DocumentManager.MdiActiveDocument.AcadDocument
 4         Dim curLayer As Autodesk.AutoCAD.Interop.Common.AcadLayer = Thisdrawing.ActiveLayer
 5         Dim newLayer As Autodesk.AutoCAD.Interop.Common.AcadLayer
 6         For Each la As Autodesk.AutoCAD.Interop.Common.AcadLayer In Thisdrawing.Layers
 7             If la.Name = "layer1" Then
 8                 newLayer = la
 9                 Thisdrawing.ActiveLayer = newLayer
10             End If
11         Next
12 
13     End Sub

View Code

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

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

 1 Public Sub ChangeLayer(ByRef LayerName As String)
 2 
 3         Acadapp.ActiveDocument.SetVariable("Clayer", LayerName)
 4         Acadapp.ActiveDocument.SetVariable("CELTYPE", "Bylayer")
 5 
 6         'For Each entry As Object In Acadapp.ActiveDocument.layers
 7         '    If entry.name = LayerName Then
 8         '        Acadapp.ActiveDocument.Activelayer = entry
 9         '        Exit For
10         '    End If
11         'Next entry
12 
13         ''改变线型
14         'For Each entry As Object In Acadapp.ActiveDocument.Linetypes
15         '    If entry.name = "Bylayer" Then
16         '        Acadapp.ActiveDocument.ActiveLinetype = entry
17         '        Exit For
18         '    End If
19         'Next
20 
21     End Sub
22     '改变标注样式 //20190606 nan sheng modify 
23     Public Sub ChangeDimStyles(ByRef Name As String)
24         Acadapp.ActiveDocument.SendCommand("-dimstyle" & vbCr & "r" & vbCr & Name & vbCr) REM "_zoom" & vbCr & "a" & vbCr
25         'ThisDrawing.SendCommand ("-dimstyle" & vbCr & "r" & vbCr & "111" & vbCr)
26         'For Each entry As Object In Acadapp.ActiveDocument.DimStyles
27         '    If entry.name = Name Then
28         '        Acadapp.ActiveDocument.ActiveDimStyle = entry
29         '        Exit For
30         '    End If
31         'Next entry
32     End Sub
33 
34     '改变文字样式//20190606 nan sheng modify 
35     Public Sub ChangeTextStyles(ByRef Name As String)
36         Acadapp.ActiveDocument.SetVariable("TEXTSTYLE", Name)
37         'For Each entry As Object In Acadapp.ActiveDocument.TextStyles
38         '    If entry.name = Name Then
39         '        Acadapp.ActiveDocument.ActiveTextStyle = entry
40         '        Exit For
41         '    End If
42         'Next entry
43     End Sub

View Code

NetApi切换图层

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

 1 <CommandMethod("myclNetApi")>
 2     Public Sub MySubLayerChangeNetApi()
 3         Dim doc As Document = Application.DocumentManager.MdiActiveDocument
 4         Dim db As Database = doc.Database
 5         Using trans As Transaction = db.TransactionManager.StartTransaction()
 6             Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
 7             If lt.Has("layer1") Then
 8                 db.Clayer = lt("layer1")
 9             End If
10             trans.Commit()
11         End Using
12 
13     End Sub

View Code

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

相关推荐