如题，本文记录了使用VBA脚本批量提取ZWCAD中图纸信息，包括标题栏、图框、参数栏、明细表里面的信息。
原始需求：
需要统计企业内部生产图纸，获取某些部件所选用规格的情况，用于拟合数学模型。目标：最终能够根据客户需求的工况来预测合适的部件规格。
难点：
而这个工作的难点在于，这是一个纯粹的杂活，费时费力，需要投入大量精力以后才能搭建模型，而且模型也不一定有效（有时间投入成本...）。因此，在不断重复相同动作的过程中，在精神上也十分折磨，不确定是不是浪费时间。
原始方案：
通过VBA脚本从企业的图库中筛选符合要求的图纸，然后下载自己工位电脑上，然后再手动逐个打开图纸，记录图纸中图框、明细表中内容。
突破点：
请见帖子-------请问如何通过VBA去获取图框里面的设置的信息？ - 中望技术社区-提供二三维CAD产品使用教程、问答交流、软件下载-中望软件官方技术交流社区 (zwsoft.cn) https://forum.zwsoft.cn/ask/16510.html
在ZWCAD的安装路径下面找到了案例文档，文档（中望机械PLM接口说明文档）中包含了例子以及API介绍Word文档
（“D:\zwcad2022机械\ZWCAD2022\Zwcadm\Sample\Sdk\Vba\Proway.zvb"），然后结合文档的内容编写自己的脚本。
```VBA
Public Sub NewLoadDate()
Dim acadObject As Object
Dim blk As Object
Dim br As Object
Dim lenTitle As Integer
Dim lenBOM As Integer
Dim foundBomTitle As Boolean
Dim bUseZwmToolkit As Boolean '注意，这个变量决定是用中望机械的接口还是用属性块查询的方式来提取数据，推荐用中望机械的接口
On Error Resume Next '以下处理了一些由于未知原因的出错
Err.Clear
mvarTitleString = "": mvarBOMString = ""
bUseZwmToolkit = True '注意，推荐用中望机械的接口提取数据
If bUseZwmToolkit Then
'中望机械的接口提取数据，可以定义为对应的类型，记得先引用ZwmToolKitLib库
'Dim objZwmApp As ZwmToolKitLib.ZwmApp
'Dim objZwmDb As ZwmToolKitLib.ZwmDb
'Dim objZwmTitle As ZwmToolKitLib.Title
'Dim objZwmBom As ZwmToolKitLib.Bom
Dim objZwmApp As Object
Dim objZwmDb As Object
Dim objZwmTitle As Object
Dim objZwmBom As Object
Dim objZwmFrame As Object
'Set objZwmApp = GetInterfaceObject("ZwmToolKit.ZwmApp")
Set objZwmApp = ThisDrawing.application.GetInterfaceObject("ZwmToolKit.ZwmApp")
‘这里从CAD中直接获取ThisDrawing对象，如果是在EXCEL中那么需要先定义CADApp对象，再通过App.ActiveDoc获取Drawing对象。
Dim strCadPath As String
’这里演示了一下API接口
objZwmApp.GetCadPath strCadPath ‘获取CAD路径
objZwmApp.GetDb objZwmDb
objZwmDb.OpenFile "" ‘打开文件
Dim nFrameCount As Long
objZwmDb.GetFrameCount nFrameCount ‘获取图框的数量
'如果图中有多个图框，这里取其中图框数据
If nFrameCount > 0 Then
Dim strFrameName As String
objZwmDb.GetFrameName 0, strFrameName
objZwmDb.SwitchFrame strFrameName ’获取图框名字
End If
objZwmDb.GetTitle objZwmTitle ’获取标题栏对象
objZwmDb.GetBom objZwmBom ’获取明细表对象
objZwmDb.Getframe objZwmFrame ‘获取图框对象
Debug.Print objZwmFrame.HaveCSL ‘查看图框中是否存在参数栏
'得到标题栏数据
Dim nTitlePropCount As Long
Dim n As Long
nTitlePropCount = -1
objZwmTitle.GetItemCount nTitlePropCount ‘获取标题栏中项目
For n = 0 To nTitlePropCount - 1
Dim name As String
Dim label As String
Dim value As String
objZwmTitle.GetItem n, label, name, value
'组合title数据，这里包含了标题栏的信息
'name
mvarTitleString = mvarTitleString & label & CADSPLIT0 & Trim(value) & CADSPLIT1
mvarTitleString = mvarTitleString & name & CADSPLIT0 & Trim(value) & CADSPLIT1
Next n
'得到明细表数据
Dim nBomRowCount As Long
Dim k As Long
nBomRowCount = -1
objZwmBom.GetItemCount nBomRowCount ‘获取明细表中项目
For k = 0 To nBomRowCount - 1
Dim objZwmBomRow As Object
objZwmBom.GetItem k, objZwmBomRow
Dim nItemCount As Long
Dim j As Long
nItemCount = -1
objZwmBomRow.GetItemCount nItemCount
For j = 0 To nItemCount - 1
Dim item_name As String
Dim item_label As String
Dim item_value As String
objZwmBomRow.GetItem j, item_label, item_name, item_value
'组合bom数据，这里是明细表的数据
mvarBOMString = mvarBOMString & item_label & CADSPLIT0 & Trim(item_value) & CADSPLIT1
mvarBOMString = mvarBOMString & item_name & CADSPLIT0 & Trim(item_value) & CADSPLIT1
Next j
mvarBOMString = mvarBOMString & CADSPLIT2
Next k
End If
End Sub
```VBA
未解决的内容：
无法获取CAD图纸中参数栏的信息，这导致获取的数据不全所以还是需要手动打开文件一个个去记录。
突破点：
同见帖子（https://forum.zwsoft.cn/ask/16510.html）
Sub testGetCSL()
Dim objZwmApp As Object
Dim objZwmDb As Object
Dim objZwmFrame As Object
Dim strFrameName As String
Dim strCslStyleName As String
Set objZwmApp = ThisDrawing.Application.GetInterfaceObject("ZwmToolKit.ZwmApp")
objZwmApp.GetDb objZwmDb ‘定义库对象
objZwmDb.openfile ""
objZwmDb.GetFrameName 0, strFrameName
objZwmDb.GetFrame objZwmFrame
If objZwmFrame.HaveCSL Then
strCslStyleName = objZwmFrame.CslStyleName
Else
MsgBox "没有参数栏信息"
Return
End If
ThisDrawing.Utility.Prompt "图框名:" & strFrameName & vbCr & "参数栏样式名:" & strCslStyleName & vbCr
Dim strCslName As String
strCslName = strFrameName & strCslStyleName
ThisDrawing.Utility.Prompt strCslName & vbCr ‘设置提示信息
Dim gpCode(0) As Variant
Dim dataValue(0) As Variant
gpCode(0) = 2
dataValue(0) = strCslName
Dim ssetObj As ZcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("SSET").Delete ‘清除选择集
On Error GoTo 0
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET") ‘新建选择集
ssetObj.Select zcSelectionSetAll, FilterType:=gpCode, FilterData:=dataValue
If ssetObj.Count <> 1 Then
MsgBox "获取参数栏错误"
End If
Dim blkRef As ZcadBlockReference
Set blkRef = ssetObj.Item(0)
If blkRef.HasAttributes Then
Dim objAttributes As Variant
objAttributes = blkRef.GetAttributes
For i = 0 To UBound(objAttributes)
ThisDrawing.Utility.Prompt "tag:" & objAttributes(i).TagString & " value:" & objAttributes(i).TextString & vbCr
Next
End If
End Sub
testGetCSL()主要用于获取特定类型的对象——参数栏（CSL）的信息，并对其属性进行操作。
1. 初始化ZwmApp对象：通过ThisDrawing.Application.GetInterfaceObject("ZwmToolKit.ZwmApp")获取了一个名为ZwmApp的接口对象，这是与ZwmToolKit库交互的关键对象。
2. 打开数据库文件：使用objZwmDb.openfile ""打开了当前的数据库文件。这里的空字符串可能意味着使用默认或当前的文件。
3. 获取框架名称：通过objZwmDb.GetFrameName 0, strFrameName获取了第一个框架的名称，并将该名称存储在strFrameName变量中。
4. 检查并获取参数栏样式名：检查所选框架是否有参数栏（CSL），如果有，则获取其样式名并存储在strCslStyleName变量中。如果没有参数栏，则弹出一个消息框提示“没有参数栏信息”，并结束子程序。
5. 输出信息：使用ThisDrawing.Utility.Prompt函数在命令行打印出框架名称和参数栏样式名。
6. 组合CSL名称：将框架名称和参数栏样式名组合成一个字符串strCslName，这可能是为了创建一个唯一标识参数栏的名称。
7. 创建选择集：定义了一个过滤代码数组gpCode和一个数据值数组dataValue，然后尝试删除已存在的名为“SSET”的选择集（如果有的话），并创建一个新的选择集ssetObj，用于选择所有匹配strCslName的对象。
8. 检查选择集：如果选择集中包含的对象数量不是1，则弹出一个消息框提示“获取参数栏错误”。
9. 获取块引用：从选择集中获取第一个对象，即块引用（Block Reference），并检查它是否包含属性。
10.遍历属性并输出：如果块引用包含属性，则遍历这些属性，并使用ThisDrawing.Utility.Prompt函数在命令行打印出每个属性的标签（Tag）和文本值（TextString）。
整体来看，这个子程序的从参数栏提取相关信息，包括框架名称、参数栏样式名以及属性信息。
