微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

CATIA宏如何导出具有特定名称的GeoSet下每个“隔离点”的坐标

如何解决CATIA宏如何导出具有特定名称的GeoSet下每个“隔离点”的坐标

我想从整个文档(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 举报,一经查实,本站将立刻删除。