cad怎么选择一个对象打散vba_求助如何读取对应CAD文件名的代码，以及如何提取CAD组码组值的方式。...

本帖最后由 jiamian0128 于 2019-7-25 12:32 编辑

在之前的的问题里面，我求助了如何通过EXCEL VBA 提取CAD的数据，非常感谢论坛大神的帮助，现在能满足一些基本要求了，现在把附件代码贴出来。希望论坛大神如果方便能继续指导下小白如何把一些效果完善下，改进下代码。

求助1：现在的情况是，读取的CAD文件只能是CAD程序当前打开的文件，能否把读取的CAD文件改为：当前路径名下的_Drawing1.dwg文件。能否运用thispath，currentdocname=“Drawing1”；的之类方式，把要读取的文件限定成当前文件的路径下的Drawing1.dwg文件。

求助2：能否把第一行空出来，能够自己填注释进去？然后每次提取的时候，能把上次的都清空，让新提取的值替换进来？现在的效果是比如新提取16行数据，16及16以上的行都会替换，16以下就不会替换。比如新提取出来的如果是13行数据，13及13上以上都是新数据，但是14到16行还是旧数据。求助大神能否帮改下代码，让第一行的数据不会被清空，数据从第二行开始生成，然后每次生成的时候第二行及以下的数据都先清空，然后新数据生成进去。

求助3：这个是最最困难的，已知现在能够通过定义CAD图元的组码 arrGroupCode(1) = 0: arrDataValue(1) = "LWPOLYLINE"组值。来筛选出来所有LWPOLYLINE的图元了，然后通过Select Case 属性命令.layer,来提取不同layer(图层)的CAD图元的数据，但是例如.objectname .area.layer这些属性命令局限性太大了，能输出的数据太少。现在在已知CAD图元组值组码的情况下，能否通过定义组码GroupCode和组值DataValue的方式，直接提取某个组码对应的组值？比如现在的效果是通过属性命令.layer的效果是指定该图元的图层，然后A图层的值“A”就输出出来了。能否替换为：已知图层的组码是8，组值是"A",通过定义arrGroupCode(1) = 8时提取其组值arrDataValue(1)=“A”,从而达到arr(i+1,1)=“A”的这个效果。

如果可以的话，希望论坛能先指导下我求助1和求助2的代码如何修改。求助3确实实在是比较困难目前。非常感谢。

Dim a

a = Timer

Dim acadApp As Object, acadDocs As Object, acadCurrentDoc As Object

Set acadApp = GetObject(, "AutoCAD.Application")

Set acadDocs = acadApp.Documents

Set acadCurrentDoc = acadDocs.Item(0) '目前假设当前AutoCAD仅打开一个文件 求助：可否把需要读取的CAD对象改为：当前文件路径的“Drawing”文件名的CAD文件

Dim acadSSet As Object

Dim arrGroupCode() As Integer, arrDataValue() As Variant

Dim arr()

On Error Resume Next

Set acadSSet = acadCurrentDoc.SelectionSets.Item("SS_Temp")

acadSSet.Delete

Err.Clear

On Error GoTo 0

Set acadSSet = acadCurrentDoc.SelectionSets.Add("SS_Temp")

ReDim arrGroupCode(2): ReDim arrDataValue(2)

arrGroupCode(0) = -4: arrDataValue(0) = "

arrGroupCode(1) = 0: arrDataValue(1) = "LWPOLYLINE"

arrGroupCode(2) = -4: arrDataValue(2) = "OR>"

acadSSet.Select Mode:=5, FilterType:=arrGroupCode, FilterData:=arrDataValue

ReDim arr(1 To acadSSet.Count, 1 To 10)

For i = 0 To acadSSet.Count - 1

With acadSSet.Item(i)

Select Case .Layer

Case "A"

arr(i + 1, 1) = .Layer

arr(i + 1, 2) = .Thickness

arr(i + 1, 3) = .area / 1000000

Case "B"

arr(i + 1, 1) = .Layer

arr(i + 1, 2) = .Thickness

arr(i + 1, 3) = .area / 1000000

'此处继续求助：能否能把 Select Case 的对象改为筛选到的CAD图元所对应的组码 例如 图层对应的组码是8 我多定义一个arrGroupCode(2) = 8

'然后arr(i+1,1) = "这个组码arrGroupCode=8时 的组值 例如 arrDataValue=A 这样的效果"

'这样就不用.layer .area 这样属性命令了，毕竟属性命令的局限性太大了，非常感谢大神

End Select

End With

Next

acadSSet.Delete

Set acadSSet = Nothing

Set acadCurrentDoc = Nothing

Set acadDocs = Nothing

Set acadApp = Nothing

[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Debug.Print Timer - a

'最后一个求助：能否把这个数据产出定义到冲第2行开始生成，因为第一行我想自己标注些注释，然后每次点击都可以先把之前提取的数据清空，替换为新的提取的数据。

End Sub

1.png

(36.16 KB, 下载次数: 0)

2019-7-25 12:29 上传

求助1

2.png

(53.64 KB, 下载次数: 0)

2019-7-25 12:29 上传

求助2

3.png

(44.1 KB, 下载次数: 0)

2019-7-25 12:30 上传

求助3

2019-7-25 12:30 上传

点击文件名下载附件

47.64 KB, 下载次数: 16

求助