问题描述
我想从整个文档（CATIA树）中导出仅包含单词“ STRUCTURE”的文件夹中所有“隔离点”的名称和坐标。
This is the CATIA tree:
TEST.CATPart
--ABC STRUCTURE DEF
----GeoSet2
------GeoSet3
--------Point 1
--------Point 2
------GeoSet4
--------GeoSet5
-----------Point 3
因此excel中的数据将显示为：
点1 | x坐标| y坐标| z坐标| GeoSet2 |
点2 | x坐标| y坐标| z坐标| GeoSet2 |
点3 | x坐标| y坐标| z坐标| GeoSet4 |
实际上我已经找到了代码，但是它仅适用于常规3d点，不适用于孤立点。 这里的代码：
Sub CATMain()
On Error Resume Next
Dim docPart As Document
Dim myPart As Part
Dim hybBodies As HybridBodies
Dim hybBody As HybridBody
Dim hybShapes As HybridShapes
Dim hybShape As HybridShape
Dim arrXYZ(2)
Dim s As Long
Const Separator As String = ";"
Set docPart = CATIA.ActiveDocument
Set MyWkBnch = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
If Err.Number <> 0 Then
MsgBox "No Active Document",vbCritical
Exit Sub
End If
'Start Excel
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") = "Point Name"
objGEXCELSh.cells(1,"B") = "X"
objGEXCELSh.cells(1,"C") = "Y"
objGEXCELSh.cells(1,"D") = "Z"
objGEXCELSh.cells(1,"E") = "Parent.Parent Name"
Set sSel = CATIA.ActiveDocument.Selection
sSel.Clear
AppActivate ("CATIA V5")
sSel.Search "(Name=*STRUCTURE* & CATPrtSearch.OpenBodyFeature),all"
Set oHybridBody = sSel.Item(1).Value
Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Search "CATPrtSearch.Point,sel"
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
For s = 1 To selection1.Count
Set hybShape = selection1.Item(s).Value
Set hybShapes = hybBody.HybridShapes
'Extract coordinates
hybShape.GetCoordinates arrXYZ
Set hybridBody1 = hybridBodies1.Item(s).Value
objGEXCELSh.cells(s + 1,"A") = hybShape.Name
objGEXCELSh.cells(s + 1,"B") = arrXYZ(0)
objGEXCELSh.cells(s + 1,"C") = arrXYZ(1)
objGEXCELSh.cells(s + 1,"D") = arrXYZ(2)
objGEXCELSh.cells(s + 1,"E") = hybShape.Parent.Parent.Parent.Name
Next s
objGEXCELSh.columns("A").autofit
objGEXCELSh.columns("E").autofit
AppActivate ("Microsoft Excel")
End Sub
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）