我有一个包括2个部分的组装。我想把第一部分的一张脸作为设计第二部分的输入。在CATProduct Workbench交互中,我只在第一部分中选择我想要的面,假设我正在运行Pad命令并需要该面作为参考平面,然后在我正在设计的工作台中自动创建该面的副本(对于第二部分),通过它引用Pad命令并完成。在VBA编程中,如果我在第一部分中为面部使用选择,则会出现错误,因为面部不在工作台中(如上所述不会自动创建副本)。如果有人有一个想法或解决这个问题,请让我知道!提前感谢您的帮助!
这是我的代码的副本:
Sub CATMain()
Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = productDocument1.Product
Dim products1 As Products
Set products1 = product1.Products
Set partDocument1 = products1.Item(1)
MsgBox partDocument1.PartNumber
Dim partDoc1 As PartDocument
Set partDoc1 = partDocument1.GetMasterShapeRepresentation(True)
'Dim partDocument2 As PartDocument
Set partDocument2 = products1.Item(2)
MsgBox partDocument2.PartNumber
Dim partDoc2 As PartDocument
Set partDoc2 = partDocument2.GetMasterShapeRepresentation(True)
Dim oSel_1 As Object
Set oSel_1 = partDoc1.Selection
Dim InputObjectType(0) As String
Dim Status As String
InputObjectType(0) = "Face" 'the needed face is cylindrical
Status = oSel_1.SelectElement4(InputObjectType, "Select a face", "Select face", True, partDoc2)
'error keep occuring here with the message "Type mismatch".
MsgBox Status
If (Status = "Normal") Then
partDoc2.Selection.Copy
oSel_1.Clear
oSel_1.Add partDoc1.Part.HybridBodies.Item(1) 'first hybrid body
oSel_1.PasteSpecial "CATPrtResult"
End If
End Sub
这里有一个如何将飞机从产品的一个部分复制到另一个部分的例子。注意:一些错误处理程序缺失,只适用于在树中有自己条目的几何体(没有BREP)
Sub CATMain()
Dim ProdDocument as ProductDocument
Dim TargetPart as Part
Dim TargetHBodie as Hybridbody
Dim oSel as Object
Dim Filter(0) as String
Dim SelStatus as String
Set ProdDocument = CATIA.ActiveDocument
Set oSel = ProdDocument.Selection
Filter(0) = "Part"
SelStatus = oSel.SelectElement2(Filter, "Please select target part", false)
if SelStatus <> "Normal" then
MsgBox "Selection canceled"
Exit Sub
end if
Set TargetPart = oSel.Item2(1).Value
Set TargetHBodie = TargetPart.Hybridbodies.Item(1)
Filter(0) = "Plane"
SelStatus = oSel.SelectElement2(Filter, "Please select plane to copy", false)
if SelStatus <> "Normal" then
MsgBox "Selection canceled"
Exit Sub
end if
oSel.Copy
oSel.Clear
oSel.Add TargetHBodie
oSel.PasteSpecial "CATPrtResult"
End Sub