如何通过VBA从CATDrawing中获取每个Balloon对应的ZONE信息？

可以实现该需求，核心思路是通过Balloon的位置坐标匹配工程图的区域网格，结合图纸编号生成类似SheetNoB2的区域标识。

工程图区域示例： #

A 1 2 3 4 5 6 7 8 9 A
B   BallonNumber    B
C                   C
D                   D
E 1 2 3 4 5 6 7 8 9 E

修改后的VBA代码（含区域计算逻辑）： #

Sub GetBalloonZones()   
    Dim CATIA As Object
    On Error Resume Next
    Set CATIA = GetObject(, "CATIA.Application")
    If Err.Number <> 0 Then
        Set CATIA = CreateObject("CATIA.Application")
        CATIA.Visible = True
    End If
    On Error GoTo 0

    Dim drawingDoc As DrawingDocument
    Dim activeSheet As DrawingSheet
    Dim drwView As DrawingViews
    Dim currentText As DrawingText
    Dim leaders As DrawingLeaders
    Dim balloonX As Double, balloonY As Double
    Dim zoneRow As String, zoneCol As String
    Dim sheetName As String

    For Each oDoc In CATIA.Documents
        If TypeName(oDoc) = "DrawingDocument" Then
            Set drawingDoc = oDoc
            drawingDoc.Activate
            Set activeSheet = drawingDoc.Sheets.ActiveSheet
            sheetName = Replace(activeSheet.Name, " ", "") ' 清理图纸名称空格
            Set drwView = activeSheet.Views

            For i = 1 To drwView.Count
                For numtxt = 1 To drwView.Item(i).Texts.Count
                    Set currentText = drwView.Item(i).Texts.Item(numtxt)
                    Set leaders = currentText.Leaders

                    ' 判断当前文本是否为Balloon（圆形框标识）
                    If (currentText.FrameName Like "Circle*" Or currentText.FrameName Like "Variable_Circle") And _
                       (currentText.Name Like "Text.*" Or currentText.Name Like "Balloon.*") Then

                        ' 获取Balloon的本地坐标，转换为图纸全局坐标
                        currentText.GetPosition balloonX, balloonY
                        balloonX = balloonX * drwView.Item(i).Scale + drwView.Item(i).X
                        balloonY = balloonY * drwView.Item(i).Scale + drwView.Item(i).Y

                        ' --------------------------
                        ' 需自行修改以下网格参数适配你的图纸
                        Dim rowHeight As Double, colWidth As Double
                        Dim startX As Double, startY As Double
                        rowHeight = 100 ' 区域行高度（单位：mm，根据实际调整）
                        colWidth = 100 ' 区域列宽度（单位：mm，根据实际调整）
                        startX = 50 ' 区域网格左上角X坐标
                        startY = 500 ' 区域网格左上角Y坐标
                        ' --------------------------

                        ' 计算区域列数字
                        zoneCol = CStr(Int((balloonX - startX) / colWidth) + 1)
                        ' 计算区域行字母（A对应ASCII码65）
                        Dim rowIndex As Integer
                        rowIndex = Int((startY - balloonY) / rowHeight)
                        zoneRow = Chr(65 + rowIndex)

                        ' 生成最终区域标识
                        Dim zoneID As String
                        zoneID = sheetName & zoneRow & zoneCol

                        ' 输出结果到立即窗口
                        Debug.Print "Balloon编号: " & currentText.Text
                        Debug.Print "区域标识: " & zoneID
                        Debug.Print "-------------------------"
                    End If
                Next numtxt
            Next i
        End If
    Next
End Sub

关键说明： #

• 坐标转换：代码中通过视图的Scale、X、Y属性将Balloon的本地坐标转换为图纸全局坐标，确保位置计算准确
• 网格参数：rowHeight、colWidth、startX、startY需要根据你的工程图实际网格尺寸修改；进阶可通过读取图纸网格线对象自动获取这些参数
• 兼容性：部分CATIA版本可能内置Zone对象，可尝试通过DrawingSheet.Zones集合匹配坐标，手动计算方式兼容性更强

内容的提问来源于stack exchange，提问作者Sidamallappa LIMBIKAI