Point使用CATVBA重命名和協調

Question

我開發了一段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 

Answer 1

這是一個遲到的答案，但我希望它仍然有幫助。

首先，最CATIA藏品的使用範圍從1到.Count中，所以您應將循環更改爲：

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

此外，如CR約翰遜在評論中指出的，你可以只有在類型爲HybridShapePointCoord的情況下才能直接檢索點座標。

但你也可以使用Spaworkbench和Measurable對象檢索有關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