Sidtha
Aerospace
- Nov 25, 2012
- 32
Hello All,
I am getting the Balloon number from the catia V5 drawings but not able to get the postion of the balloon from the draing view.
Below is my code to get the balloon number, Please help me to get the balloon positon from the drawing view.
Dim wb As Workbook, ws As Worksheet
Sub BOMExtract()
Dim CATIA As Object
Dim myselection As Selection
Dim textlist() As String
Dim showstate As CatVisPropertyShow
Dim dblViewScale As Double
Set wb = ThisWorkbook
Set ws = wb.Sheets("BOM")
LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A6:H1000").ClearContents
Set CATIA = GetObject(, "CATIA.Application")
Dim DrawingDocument1 As Document
Set DrawingDocument1 = CATIA.ActiveDocument
Set oDrwView = DrawingDocument1.Sheets.ActiveSheet.Views
Dim pattern As String
pattern = "\b(?:\d{1,3}-\d{1,2}|((?<!-)1\d{3}))\b"
j = 6
For i = 1 To oDrwView.Count
For numtxt = 1 To oDrwView.Item(i).Texts.Count
Set CurrentText = oDrwView.Item(i).Texts.Item(numtxt)
If CurrentText.Name Like "*Balloon*" Then
ws.Cells(j, 1).Value = CurrentText.text
j = j + 1
End If
Next numtxt
Next i
On Error GoTo 0
End Sub
I am getting the Balloon number from the catia V5 drawings but not able to get the postion of the balloon from the draing view.
Below is my code to get the balloon number, Please help me to get the balloon positon from the drawing view.
Dim wb As Workbook, ws As Worksheet
Sub BOMExtract()
Dim CATIA As Object
Dim myselection As Selection
Dim textlist() As String
Dim showstate As CatVisPropertyShow
Dim dblViewScale As Double
Set wb = ThisWorkbook
Set ws = wb.Sheets("BOM")
LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A6:H1000").ClearContents
Set CATIA = GetObject(, "CATIA.Application")
Dim DrawingDocument1 As Document
Set DrawingDocument1 = CATIA.ActiveDocument
Set oDrwView = DrawingDocument1.Sheets.ActiveSheet.Views
Dim pattern As String
pattern = "\b(?:\d{1,3}-\d{1,2}|((?<!-)1\d{3}))\b"
j = 6
For i = 1 To oDrwView.Count
For numtxt = 1 To oDrwView.Item(i).Texts.Count
Set CurrentText = oDrwView.Item(i).Texts.Item(numtxt)
If CurrentText.Name Like "*Balloon*" Then
ws.Cells(j, 1).Value = CurrentText.text
j = j + 1
End If
Next numtxt
Next i
On Error GoTo 0
End Sub