CATIA V5R24中VBA宏实例化PowerCopy报错及无KT1许可证替代方案问询

一、排查factory.BeginInstanceFactory运行时错误（80004005） #

你遇到的这个自动化错误通常和文件路径、PowerCopy引用有效性或系统权限有关，我给你梳理几个实用的排查方向：

• 核对文件路径与PowerCopy名称
  你代码里注释标注的参考零件路径是e:\tmp\PowerCopyReference.CATPart，但实际调用用的是C:\PowerCopyReference.CATPart，先确认文件真实存在的路径，而且路径里不要包含中文、空格或特殊字符。另外要保证PowerCopy的名称SurfacicHoles和参考零件里的完全一致（CATIA对名称大小写是敏感的），可以手动打开参考零件确认一下。

• 验证InstanceFactory的有效性
  在获取工厂对象后加个判断，确保没有获取失败，同时也能提前验证KT1许可证是否可用：

  Dim factory As InstanceFactory
  Set factory = PartDest.GetCustomerFactory("InstanceFactory")
  If factory Is Nothing Then
      MsgBox "无法获取InstanceFactory，请检查KT1许可证是否激活"
      Exit Sub
  End If
  

• 解决系统权限问题
  Windows 7 64位下，C盘根目录的文件访问可能需要管理员权限，建议你把参考零件移到非系统盘（比如D盘），或者以管理员身份启动CATIA再运行宏。另外要确保参考零件没有被其他程序锁定（比如之前打开后没正常关闭）。

二、无KT1许可证时自动使用PowerCopy的替代方法 #

如果确实没有KT1许可证，InstanceFactory这条路走不通，你可以试试这两个可行的方案：

1. 录制宏+动态选择元素 #

手动录制一次插入PowerCopy的操作，然后修改录制的代码，实现自动选中输入元素并调用命令。示例思路如下：

Private Sub CommandButton1_Click()
    Dim CATIA As Object
    Set CATIA = GetObject(, "CATIA.Application")
    Dim PartDest As Part
    Set PartDest = CATIA.ActiveDocument.Part
    
    ' 预先选中需要的输入元素
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    sel.Clear
    sel.Add PartDest.FindObjectByName("Point.1")
    sel.Add PartDest.FindObjectByName("Surface.1")
    sel.Add PartDest.FindObjectByName("Point.2")
    
    ' 调用插入PowerCopy的命令（具体代码以你录制的为准）
    CATIA.StartCommand("Insert PowerCopy...")
    
    ' 后续修改参数：找到生成的PowerCopy实例调整参数
    Dim inst As ShapeInstance
    Set inst = PartDest.ShapeInstances.Item("SurfacicHoles.1")
    inst.Parameters.Item("Radius1").ValuateFromString "25mm"
    inst.Parameters.Item("Radius2").ValuateFromString "15mm"
    
    PartDest.Update
End Sub

注意：这种方法可能需要处理弹出的对话框，如果要完全自动化，可能需要用SendKeys模拟输入，但稳定性会稍差一点。

2. 转换为知识工程模板（Knowledge Template） #

把你的PowerCopy转换为知识工程模板（Template），然后通过知识工程API来实例化，这个不需要KT1许可证。步骤大概是：

• 在CATIA里打开参考零件，把PowerCopy保存为.CATTemplate文件；
• 使用KnowledgeFactory来加载模板并绑定输入、修改参数，示例代码框架：

  Dim knowledgeFactory As KnowledgeFactory
  Set knowledgeFactory = PartDest.GetCustomerFactory("KnowledgeFactory")
  Dim templateInst As TemplateInstance
  Set templateInst = knowledgeFactory.CreateTemplateInstance("SurfacicHoles", "C:\YourTemplate.CATTemplate")
  ' 绑定输入元素
  templateInst.PutInputData "FirstHole", PartDest.FindObjectByName("Point.1")
  ' 修改参数
  templateInst.Parameters.Item("Radius1").ValuateFromString "25mm"
  ' 实例化
  templateInst.Instantiate
  PartDest.Update
  

附你的原始代码供参考：

Private Sub CommandButton1_Click() 
' Instantiation of a PowerCopy Reference "SurfacicHoles" 
' SurfacicHoles is stored in the CATPart "e:\tmp\PowerCopyReference.CATPart" 
' It has 
' 3 inputs: FirstHole, Support,and SecondHole 
' 2 published parameters: Radius1 and Radius2 
'------------------------------------------------------------------ 
'------------------------------------------------------------------ 
Dim CATIA As Object 
Set CATIA = GetObject(, "CATIA.Application") 
Dim SysS As Object 
Set SysS = CATIA.SystemService 
Dim SpassString As String 
'CATIA.SystemService.Print ("Retrieve the current part") 
SpassString = SysS.Print("Retrive the current part") 
Dim PartDocumentDest As PartDocument 
Set PartDocumentDest = CATIA.ActiveDocument 
Dim PartDest As Part 
Set PartDest = PartDocumentDest.Part 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Retrieve the factory of the current part" 
SpassString = SysS.Print("Retrieve the factory of the current part") 
Dim factory As InstanceFactory 
Set factory = PartDest.GetCustomerFactory("InstanceFactory") 
'Debug.Print factory.Name 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "BeginInstanceFactory" 
SpassString = SysS.Print("BeginInstanceFactory") 
factory.BeginInstanceFactory "SurfacicHoles", "C:\PowerCopyReference.CATPart" 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Begin Instantiation" 
SpassString = SysS.Print("Begin Instantiation") 
factory.BeginInstantiate 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Set Inputs" 
SpassString = SysS.Print("Set Inputs") 
Dim FirstHole As Object 
Set FirstHole = PartDest.FindObjectByName("Point.1") 
Dim Support As Object 
Set Support = PartDest.FindObjectByName("Surface.1") 
Dim SecondHole As Object 
Set SecondHole = PartDest.FindObjectByName("Point.2") 
factory.PutInputData "FirstHole", FirstHole 
factory.PutInputData "Support", Support 
factory.PutInputData "SecondHole", SecondHole 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Modify Parameters" 
SpassString = SysS.Print("Modify Parameters") 
Dim param1 As Parameter 
Set param1 = factory.GetParameter("Radius1") 
param1.ValuateFromString ("25mm") 
Dim param2 As Parameter 
Set param2 = factory.GetParameter("Radius2") 
param2.ValuateFromString ("15mm") 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Instantiate" 
SpassString = SysS.Print("Instantiate") 
Dim Instance As ShapeInstance 
Set Instance = factory.Instantiate 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "End of Instantiation" 
SpassString = SysS.Print("End of Instantiation") 
factory.EndInstantiate 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Release the reference document" 
SpassString = SysS.Print("Release the reference document") 
factory.EndInstanceFactory 
'------------------------------------------------------------------ 
'CATIA.SystemService.Print "Update" 
SpassString = SysS.Print("Update") 
PartDest.Update 
End Sub 

内容的提问来源于stack exchange，提问作者Sebastian