AutoCAD中的AutoCAD架构愿景工具

Question

我的系统上同时安装了AutoCAD和AutoCAD架构。AutoCAD建筑有一个名为视觉工具的选项卡，其中包含一个名为Display By Layer的漂亮命令，可以根据图形的图层设置对象的显示顺序。在AutoCAD中有没有添加此选项卡或使用此命令的方法？

Answer 1

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

有关内置功能，请查看DRAWORDER command。对于API/编程方法，请检查相应的DrawOrderTable方法。如下所示：

更新：请同时检查此第三方工具：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的帮助下，它可能看起来像这样。请注意，我没有添加花哨的列表框代码。我只是向worker展示了如何列出层。向表单列表框添加内容以及如何对列表框项目进行排序/重新排列的简单代码可以在网上的任何excel / VBA论坛上找到。或者，您只需使用示例中所示的预定义字符串。要使VBA正常工作，请下载并安装acc。来自autocad的VBA Enabler。它是免费的。

           '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宏列表中选择它。