LW多边形自定义属性

AstroNout · 发表于 2022-7-6 22:26:25

嗨，伙计们

我的问题类似于安德的问题。我在使用从SHP到多段线转换的自定义特性时遇到了一些问题。

我将形状作为多段线插入，其中包含来自形状文件数据库的额外属性。到现在为止，一直都还不错。但是现在我想把多段线放到不同的层中，这取决于我刚刚创建的属性。

问题是，我似乎无法使用VBA编码从自定义属性中获取数组，甚至是某种变体对象。对于LW Poly，这可能吗？我正在使用AutoCAD MAP 3D 2011。

我有一个开始的代码：

copy

Sub Layer()
   Dim Ent As AcadEntity
   Dim pLine As AcadLWPolyline
   Dim aAttributes As Variant
   Dim Attrib As Variant
   Dim Layer As AcadLayer
   Dim sText As String
   
   For Each Ent In ThisDrawing.ModelSpace
       If TypeOf Ent Is AcadLWPolyline Then
           Set pLine = Ent
           aAttributes = pLine.GetAttributes
           
           Select Case pLine.Layer
           Case "ggba"
               For Each Attrib In aAttributes
                   If Attrib.TagString = "TPC" Then
                       sText = Attrib.TextString
                       Set Layer = ThisDrawing.Application.ActiveDocument.Layers.Add("GBA" & sText)
                       pLine.Layer = Layer
                   End If
               Next Attrib
           End Select
       End If
   Next
End Sub

显然是。getattribute方法不适用于LW多边形。

非常感谢您的帮助，
谢谢

BIGAL · 发表于 2022-7-6 22:32:30

您需要获取坐标而不是属性。

也可以通过web搜索“vba多段线顶点”http://www.cadtutor.net/forum/showthread.php?7823-通过VBA获取多段线的坐标，查看Fixo解。

AstroNout · 发表于 2022-7-6 22:35:44

谢谢你的回复，但这不是我想说的。我知道如何获得坐标，这很困难：-）

我一直在网上搜索，发现我需要的数据在“对象数据”中。然而，这是一个完全不同的故事，因为数据存储在表中，连接到CAD对象，就像它在GIS中一样。

我似乎找不到一个使用VBA在对象的对象数据中循环的好例子。这是可能的，但对我来说仍然是个谜。

Tyke · 发表于 2022-7-6 22:38:47

如果您的意思是“对象数据”，则可以访问图层属性（Object.layer），并将其直接设置为希望LW多段线处于的图层。正如您在代码中所演示的那样。

如果您指的是存储在GIS中的数据，则可以使用扩展数据来访问它。我们从GIS导出DXF文件，所有连接到对象的数据都导出为扩展数据。我编写了一个查看器来显示连接到选定对象的所有数据，这并不总是无关紧要的，有些对象连接了100多个数据项。使用Express工具查看是否有任何LW多段线附加了扩展数据，如果有，请修改代码以处理扩展数据而不是属性。

我不太确定你想用你的代码实现什么。正如您正确地说的那样，LW多段线不能有属性，因此变量aAttributes将始终为空，case循环中的代码将永远不会执行。在您的代码中，如果“TPC”不是属性，那么它是什么？

AstroNout · 发表于 2022-7-6 22:43:30

嗯，政府发给我们整个城市的形状文件，以检查我们调查的新特征。由于我们使用AutoCAD，因此更容易将整个地块转换为DWG。只需要交付调整。

问题是形状中的一些线表示不同的东西。形状建筑物中有所有主要和次要建筑物。为了实用，我们想把不同类型的建筑放在不同的层中。将形状输入AutoCAD时，属性将作为OD:ShapeName输入。我怀疑这是帮助文件中提到的“对象数据”。表示主楼或副楼的属性是“TPC”。

希望这有帮助。

Tyke · 发表于 2022-7-6 22:50:00

单击LW多段线时，在“属性”窗格中会看到什么？对于块，如果其具有属性，则这些属性与其当前值一起列在“属性”窗格的底部。

当您转到功能区>工具组>列表扩展数据按钮上的“快速工具”选项卡时，在文本窗口中会看到什么。系统会提示您选择对象，然后“输入应用程序名称：”只需按Enter键。如果对象具有扩展数据，则会列出它，如果没有，则会收到消息“没有与应用程序名称关联的扩展数据”

你能举个小例子吗？

AstroNout · 发表于 2022-7-6 22:53:45

在属性中，我得到了我需要的数据，一直在底部。

以下是您询问的列表：

copy

* Registered Application Name: AcMap_E615D161-C9D7-11d3-839F-0060B0FB6B57
* Code 1071, 32-bit signed long integer: 2
* Code 1071, 32-bit signed long integer: 16
* Code 1071, 32-bit signed long integer: 1
Object has 16365 bytes of Xdata space available.

Tyke · 发表于 2022-7-6 22:57:45

好的，这里的数据是来自文本窗口的扩展数据，而不是属性。您是否也在“属性窗格”中获取信息？
单词“Code”后面的数字是DXF代码，DXF代码1000到1071（含1000到1071）保留用于扩展数据。

除了代码1001之外，所有代码都可以在一组扩展数据中多次使用。1001是应用程序名称，只能出现一次。
代码1003是与扩展数据相关的层，它可能对您有用。

有两种方法与数据“GetXData”和“SetXData”相关。

您可以检索LW多段线的扩展数据，然后在扩展数据中循环，直到找到所需的条目，然后相应地设置LW多段线的图层特性。

Tyke · 发表于 2022-7-6 23:01:15

尝试检查地图帮助文件中的扩展数据、元数据、ObjectData、DataTables等。

这里似乎有很多关于这些主题的信息，这是你在第3篇文章中谈到的。

AstroNout · 发表于 2022-7-6 23:03:05

好的，谢谢。但它似乎不适用于GetXData函数。我总是得到空的变量数组，所以，没有帮助。

因此，现在我们正忙于处理数据表和ObjectData，不过，我刚刚遇到了AutoCAD的致命崩溃，几秒钟后，VBA管理器由于内存溢出，在处理图形中的数据表时失去了所有编程。愉快的

我听说操作数据表是AutoCAD自定义过程中的一个大问题。显然没有在帮助文件中处理。。。有人对此有经验吗？

以下是需要调整的众多文件之一：
测验图纸

Grtz公司
天文学家

更新：
它在这条线上崩溃：

copy

Set OD = acad.Projects(ThisDrawing).ODTables.Item("ggba")

完整代码：

copy

Public Function Get_Attributes()
Dim acadOBJ As Object
Dim acad As AcadMap
Set acad = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application.5")
Dim boolVal As Boolean
Dim aLayer As AcadLayer
Dim sString As String
Dim TPC As Integer
Dim OD As ODTable ' variable to connect to PB table
Set OD = acad.Projects(ThisDrawing).ODTables.Item("ggba") ' setting up the table for use
Dim ODrcs As ODRecords
Set ODrcs = OD.GetODRecords ' get all records in the table
Dim acadOBJ_objectID() As Long 'store pillar objectID in an array
Dim ODtbs As ODTables
Dim iType As Integer
Set ODtbs = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application").Projects(ThisDrawing).ODTables
'get the field names
For i = 0 To ODtbs.Item("ggba").ODFieldDefs.Count - 1
   'get the field index of "TYPE" field
       If ODtbs.Item("ggba").ODFieldDefs.Item(i).Name = "TPC" Then
           iType = i
       End If
Next i
For Each acadOBJ In ThisDrawing.ModelSpace
   boolVal = ODrcs.Init(acadOBJ, True, False)
       Do While ODrcs.IsDone = False
           If ODrcs.Record.ObjectID = acadOBJ.ObjectID Then
               TPC = ODrcs.Record.Item(iType).Value
           End If
         ODrcs.Next
       Loop
   sString = "GBA" & TPC
   Set aLayer = ThisDrawing.Layers.Add(sString)
   acadOBJ.Layer = aLayer
Next
End Function

[编程交流] LW多边形自定义属性

发表回复

精选推荐