复制引用

  • 本文关键字:引用 复制 vba catia
  • 更新时间 :
  • 英文 :


我有一个包括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

最新更新