AutoCAD 中的 AutoCAD Architecture Vision 工具

Question

我的系统上同时安装了 AutoCAD 和 AutoCAD Architecture。 AutoCAD Architecture 有一个名为 Vision Tools 的选项卡，其中包含一个名为 Display By Layer 的漂亮命令，用于根据图形的图层设置对象的显示顺序。是否有在 AutoCAD 中添加此选项卡或使用此命令的方法？

Answer 1

不确定您是否正在寻找内置功能或 API。

对于内置功能，请查看DRAWORDER command。对于 API/编程方法，请检查相应的 DrawOrderTable 方法。见下文：

更新：还请检查此第 3 方工具：DoByLayer。

[CommandMethod("SendToBottom")]
public void commandDrawOrderChange()
{
    Document activeDoc
                = Application.DocumentManager.MdiActiveDocument;
    Database db = activeDoc.Database;
    Editor ed = activeDoc.Editor;

    PromptEntityOptions peo
                = new PromptEntityOptions("Select an entity : ");
    PromptEntityResult per = ed.GetEntity(peo);
    if (per.Status != PromptStatus.OK)
    {
        return;
    }
    ObjectId oid = per.ObjectId;

    SortedList<long, ObjectId> drawOrder
                            = new SortedList<long, ObjectId>();

    using (Transaction tr = db.TransactionManager.StartTransaction())
    {
        BlockTable bt = tr.GetObject(   
                                        db.BlockTableId,
                                        OpenMode.ForRead
                                    ) as BlockTable;
        BlockTableRecord btrModelSpace =
                tr.GetObject(
                                bt[BlockTableRecord.ModelSpace],
                                OpenMode.ForRead
                            ) as BlockTableRecord;

        DrawOrderTable dot =
                tr.GetObject(
                                btrModelSpace.DrawOrderTableId,
                                OpenMode.ForWrite
                            ) as DrawOrderTable;

        ObjectIdCollection objToMove = new ObjectIdCollection();
        objToMove.Add(oid);
        dot.MoveToBottom(objToMove);

        tr.Commit();
    }
    ed.WriteMessage("Done");
}

Answer 2

在 VBA 的帮助下，它可能看起来如此。注意我没有添加花哨的列表框代码。我只是展示了工人以及如何列出图层。可以在 web 上的任何 excel/VBA 论坛上找到向表单上的列表框添加内容以及如何排序/重新排列列表框项目的简单代码。或者您只使用示例中的预定义字符串。要让 VBA 工作，请下载并安装 acc。来自 AutoCAD 的 VBA 启用程序。这是免费的。

           'select all items on a layer by a filter    
             Sub selectALayer(sset As AcadSelectionSet, layername As String)

               Dim filterType As Variant
               Dim filterData As Variant
               Dim p1(0 To 2) As Double
               Dim p2(0 To 2) As Double

               Dim grpCode(0) As Integer
               grpCode(0) = 8
               filterType = grpCode
               Dim grpValue(0) As Variant
               grpValue(0) = layername
               filterData = grpValue
               sset.Select acSelectionSetAll, p1, p2, filterType, filterData
               Debug.Print "layer", layername, "Entities: " & str(sset.COUNT)

            End Sub

            'bring items on top
            Sub OrderToTop(layername As String)
                ' This example creates a SortentsTable object and
                ' changes the draw order of selected object(s) to top.
                Dim oSset As AcadSelectionSet
                Dim oEnt
                Dim i As Integer
                Dim setName As String

                setName = "$Order$"
                'Make sure selection set does not exist

                For i = 0 To ThisDrawing.SelectionSets.COUNT - 1
                    If ThisDrawing.SelectionSets.ITEM(i).NAME = setName Then
                        ThisDrawing.SelectionSets.ITEM(i).DELETE
                        Exit For
                    End If
                Next i

                setName = "tmp_" & time()
                Set oSset = ThisDrawing.SelectionSets.Add(setName)
                Call selectALayer(oSset, layername)

                If oSset.COUNT > 0 Then
                    ReDim arrObj(0 To oSset.COUNT - 1) As ACADOBJECT
                    'Process each object
                    i = 0
                    For Each oEnt In oSset
                        Set arrObj(i) = oEnt
                        i = i + 1
                    Next
                End If

                'kills also left over selectionset by programming mistakes....
                For Each selectionset In ThisDrawing.SelectionSets
                    selectionset.delete_by_layer_space
                Next


                On Error GoTo Err_Control
                'Get an extension dictionary and, if necessary, add a SortentsTable object
                Dim eDictionary As Object
                Set eDictionary = ThisDrawing.modelspace.GetExtensionDictionary

                ' Prevent failed GetObject calls from throwing an exception
                On Error Resume Next
                Dim sentityObj As Object
                Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")

                On Error GoTo 0

                If sentityObj Is Nothing Then
                    ' No SortentsTable object, so add one
 Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
                End If

                'Move selected object(s) to the top
                sentityObj.MoveToTop arrObj
                applicaTION.UPDATE

                Exit Sub
                  Err_Control:
                If ERR.NUMBER > 0 Then MsgBox ERR.DESCRIPTION
            End Sub


            Sub bringtofrontbylist()
                Dim lnames As String
                'predefined layer names 
                layer_names = "foundation bridge road"
                Dim h() As String
                h = split(layernames)
                For i = 0 To UBound(h)
                    Call OrderToTop(h(i))
                Next
            End Sub


            'in case you want a fancy form here is how to get list / all layers                
            Sub list_layers()
            Dim LAYER As AcadLayer
            For Each LAYER In ThisDrawing.LAYERS
                Debug.Print LAYER.NAME

            Next
            End Sub

要让它运行，请将光标放在 VBA IDE 的 list_layers 代码中，然后按 F5 或从 VBA 宏列表中选择它。