使用VBA宏在CATIA V5R24中实例化PowerCopy

时间:2018-01-24 12:05:52

标签: vba catia

我想为power copy创建宏。我从这个link中获取了代码和模型 不幸的是它没有工作(我做了很少的修改)。我在subject找到了类似的问题,在他的案例中它也有效。

 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

此步骤出现错误

factory.BeginInstanceFactory "SurfacicHoles", "C:\PowerCopyReference.CATPart"
  

运行时错误' -2147467259(80004005)':自动化错误。不明   错误

Windows 7 64位

今天我从管理层获得了新信息......我们的一些工厂无法获得KT1许可证......在这种情况下,是否还有其他方法可以使用自动电源复制?

1 个答案:

答案 0 :(得分:0)

使用BeginInstanceFactory打开实例工厂后,必须由相应的EndInstanceFactory关闭它。

现在发生了什么,特别是在开发中,你做了一个BeginInstanceFactory,然后在调用EndInstanceFactory之前的某个地方出现了问题,你必须再试一次。

但是,您的CATIA会话中的实例工厂仍处于打开状态,如果您再次尝试使用宏,则会在BeginInstanceFactory中出现错误。

所以我一直在做的最好的做法是调用EndInstanceFactory BEFORE,调用BeginInstanceFactory(当然也在最后)。如果不需要呼叫,则将被忽略。但是如果它是必需的(如果工厂由于之前的运行失败而仍然在你的会话中打开),它应该将所有东西重新置于预期的状态,以便再次打开工厂。

总而言之,试试这个:

...
Set factory = PartDest.GetCustomerFactory("InstanceFactory")
factory.EndInstanceFactory
factory.BeginInstanceFactory "SurfacicHoles","C:\PowerCopyReference.CATPart"
...