使用VBA导出CATIA V5交点坐标至Excel时遇问题求助

问题描述 #

使用VBA代码导出CATIA点坐标到Excel时，普通点可正常导出，但交点选中后无法获取坐标，报错如下：

源：Microsoft VBScript runtime error
描述：Object doesn't support this property or method:'point.GetCoordinates'
行：56

原代码如下：

Dim objGEXCELapp As Object
Dim objGEXCELwkBks As Object
Dim objGEXCELwkBk As Object
Dim objGEXCELwkShs As Object
Dim objGEXCELSh As Object
Dim fs, f, f1, fc, s
Dim coords(2) As Integer
Dim PartDocument1

Sub CATMain()

CATIA.ActiveDocument.Selection.Search "CATGmoSearch.Point,all"

StartEXCEL

ExportPoint

'objGEXCELSh.Application.ActiveWorkbook.SaveAs (ExcelFolder & Left(CATIA.ActiveDocument.Name,Len(CATIA.ActiveDocument.Name)-8) & ".xls")
'objGEXCELSh.Application.ActiveWorkbook.Close

End Sub

'******************************************************************************
Sub StartEXCEL()
'******************************************************************************
Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject (,"EXCEL.Application")

If Err.Number <> 0 Then
Err.Clear
Set objGEXCELapp = CreateObject ("EXCEL.Application")
End If

objGEXCELapp.Application.Visible = TRUE
Set objGEXCELwkBks = objGEXCELapp.Application.WorkBooks
Set objGEXCELwkBk = objGEXCELwkBks.Add
Set objGEXCELwkShs = objGEXCELwkBk.Worksheets(1)
Set objGEXCELSh = objGEXCELwkBk.Sheets (1)
objGEXCELSh.Cells (1,"A") = "Name"
objGEXCELSh.Cells (1,"B") = "X"
objGEXCELSh.Cells (1,"C") = "Y"
objGEXCELSh.Cells (1,"D") = "Z"

End Sub

'******************************************************************************
Sub ExportPoint()
'******************************************************************************
For i = 1 To CATIA.ActiveDocument.Selection.Count
Set selection = CATIA.ActiveDocument.Selection
Set element = selection.Item(i)
Set point = element.value

'Write PointData to Excel Sheet
point.GetCoordinates(coords)

objGEXCELSh.Cells (i+1,"A") = point.name
objGEXCELSh.Cells (i+1,"B") = coords(0)
objGEXCELSh.Cells (i+1,"C") = coords(1)
objGEXCELSh.Cells (i+1,"D") = coords(2)

Next

End Sub

问题原因 #

CATIA中的交点属于HybridShapePointIntersection对象，并非普通的Point对象，该对象没有GetCoordinates方法。需要通过其Geometry属性获取底层的几何点实体，才能调用坐标获取方法。

解决方法 #

修改ExportPoint子过程，先获取对象的几何实体再调用GetCoordinates，同时普通点的Geometry属性指向自身，因此兼容两种点类型：

'******************************************************************************
Sub ExportPoint()
'******************************************************************************
Dim geoPoint As Object ' 存储几何点实体
For i = 1 To CATIA.ActiveDocument.Selection.Count
    Set selection = CATIA.ActiveDocument.Selection
    Set element = selection.Item(i)
    Set point = element.value
    
    ' 获取几何点实体，兼容普通点和交点
    Set geoPoint = point.Geometry
    
    ' 获取坐标
    geoPoint.GetCoordinates(coords)
    
    objGEXCELSh.Cells(i+1,"A") = point.name
    objGEXCELSh.Cells(i+1,"B") = coords(0)
    objGEXCELSh.Cells(i+1,"C") = coords(1)
    objGEXCELSh.Cells(i+1,"D") = coords(2)
Next
End Sub

另外注意：原代码中coords(2) As Integer会导致坐标精度丢失，建议改为Double类型：

Dim coords(2) As Double

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