点重命名&使用CATVBA协调

时间:2017-08-10 05:07:05

标签: vba point catia

我开发了一段CATVBA代码来重命名和协调几何集下的点。这里的问题是,我可以重命名这些点,但协调不起作用。我能够得到几何集下每个点的坐标值,但设置协调不起作用。如果有任何解决方案,请检查并告诉我们。 P.S: - 我想制作相同点的坐标,不想用坐标值创建任何新点。感谢。

Sub CATMain()

Dim MyObj As Object, pd1 As PartDocument, a As String
Dim Result As String
ReDim InputObjectType(0) As Variant
Dim MySelection As Object

If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
    Message = MsgBox("This program only works on a CATPart.", vbDefaultButton1, "Error")
    Exit Sub
End If

Set pd1 = CATIA.ActiveDocument
Set MySelection = pd1.Selection
ReDim InputObjectType(0)
InputObjectType(0) = "HybridBody"

MsgBox "Select a Geoset in which its elements needs to renamed."

Result = MySelection.SelectElement2(InputObjectType, "Select a Geoset in which its elements needs to renamed.", False)

If Result = "Normal" Then
    Set MyObj = pd1.Selection.Item(1).Value
ElseIf Result = "Redo" Then
    MsgBox "Redo is not an option for this program."
End
Else
End
End If

Call Dumb_Renumber(MyObj)

End Sub

Sub Dumb_Renumber(x As HybridBody)

Dim n As Double, i As Integer
Dim m As String
Dim PtString As String
Dim PtNumberOld As Integer, PtNumberNew As Integer
Dim ptName As String, NewPtName As String
Dim StartPos As Integer

m = InputBox("What would be your Prefix?", "Rename Input")   'get Prefix Input from user
n = InputBox("What number would you like to start with?", "Rename Input", "100")  'get suffix input from user


For i = 0 To x.HybridShapes.Count - 1

    On Error Resume Next
    Dim coord(2)

    x.HybridShapes.Item(i + 1).GetCoordinates coord      ' i am able to get Co ordinate value here
    'MsgBox coord(0) & " " & coord(1) & " " & coord(2)

    x.HybridShapes.Item(i + 1).SetCoordinates coord      'not able to set coordinate value

    x.HybridShapes.Item(i + 1).Name = m & n + i          'this is to rename the elements under the selected geometric set

Next

End Sub

1 个答案:

答案 0 :(得分:0)

这是一个迟到的答案,但我希望它仍有帮助。

首先,大多数CATIA集合使用的范围从1到.Count,因此您应该将循环更改为:

For i = 1 To x.HybridShapes.Count
    'Code here
next

此外,正如C.R.Johnson在评论中指出的那样,只有HybridShapePointCoord类型的点坐标才能直接检索。

但您也可以使用SpaworkbenchMeasurable对象来检索有关HybridShapes的几何信息

以下是一个可行的代码示例:

Dim SPAWorkBench As SPATypeLib.SPAWorkbench
Dim Measurable As SPATypeLib.Measurable
Dim HybridBody As MECMOD.HybridBody
Dim i As Integer
Dim Coord(2)

'Initialize your variables propertly

set SPAWorkBench = Catia.ActiveDocument.GetWorkbench("SPAWorkbench")

For i = 1 To HybridBody.HybridShapes.Count

    set Measurable = SPAWorkBench.GetMeasurable(HybridBody.HybridShapes.Item(i))
    If Measurable.GeometryName = SPATypeLib.CatMeasurableName.CatMeasurablePoint Then
        Measurable.GetPoint(Coord)
                'Coord will have the points coordinates
    Else
                'Not a point, will not be possible to retrieve coordinates
    End If

Next