我准备了一个宏，它将轴添加到草图中我想要一个循环。更多轴

Question

我准备了一个宏，它将轴添加到草图中我想要一个循环。更多轴

我准备了您在几何集轴和草图中选择的代码。如果草图中有 4 个点，它将使您有 4 个轴。

Language="VBSCRIPT"
Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = partDocument1.Selection

selection1.Clear 
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
Set partDocument1 = CATIA.ActiveDocument

Dim bSTR1 As String
bSTR1 = partDocument1.Name

Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
Set partDocument1 = CATIA.ActiveDocument

Dim bSTR2 As String
bSTR2 = partDocument1.Name

Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part

selection1.Clear 

Dim arrayOfVariantOfBSTR1(0)
arrayOfVariantOfBSTR1(0) = "AxisSystem"
Dim bSTR3 As String
bSTR3 = selection1.SelectElement2(arrayOfVariantOfBSTR1, "Select Ref Axis", False)

Dim selectedElement1 As SelectedElement
Set selectedElement1 = selection1.Item(1)

Dim axisSystem1 As CATBaseDispatch
Set axisSystem1 = selectedElement1.Value

Dim bSTR4 As String
bSTR4 = axisSystem1.Name

selection1.Clear 

Dim arrayOfVariantOfBSTR2(0)
arrayOfVariantOfBSTR2(0) = "Sketch"
Dim bSTR5 As String
bSTR5 = selection1.SelectElement2(arrayOfVariantOfBSTR2, "Select A Sketch", False)

Dim selectedElement2 As SelectedElement
Set selectedElement2 = selection1.Item2(1)

Dim sketch1 As CATBaseDispatch
Set sketch1 = selectedElement2.Value

selection1.Search "Topology.Vertex, sel"

Dim long1 As Long
long1 = selection1.Count

Dim selectedElement3 As SelectedElement
Set selectedElement3 = selection1.Item(1)

Dim selectedElement4 As SelectedElement
Set selectedElement4 = selection1.Item(2)

Dim selectedElement5 As SelectedElement
Set selectedElement5 = selection1.Item(3)

Dim selectedElement6 As SelectedElement
Set selectedElement6 = selection1.Item(4)

Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements

Dim long2 As Long
long2 = geometricElements1.Count

Dim axis2D1 As GeometricElement
Set axis2D1 = geometricElements1.Item(1)

Dim long3 As Long
long3 = axis2D1.GeometricType

Dim long4 As Long
long4 = axis2D1.GeometricType

Dim point2D1 As GeometricElement
Set point2D1 = geometricElements1.Item(2)

Dim long5 As Long
long5 = point2D1.GeometricType

Dim long6 As Long
long6 = point2D1.GeometricType

Dim boolean1 As Boolean
boolean1 = point2D1.Construction

Dim bSTR6 As String
bSTR6 = point2D1.Name

Dim point2D2 As GeometricElement
Set point2D2 = geometricElements1.Item(3)

Dim long7 As Long
long7 = point2D2.GeometricType

Dim long8 As Long
long8 = point2D2.GeometricType

Dim boolean2 As Boolean
boolean2 = point2D2.Construction

Dim bSTR7 As String
bSTR7 = point2D2.Name

Dim point2D3 As GeometricElement
Set point2D3 = geometricElements1.Item(4)

Dim long9 As Long
long9 = point2D3.GeometricType

Dim long10 As Long
long10 = point2D3.GeometricType

Dim boolean3 As Boolean
boolean3 = point2D3.Construction

Dim bSTR8 As String
bSTR8 = point2D3.Name

Dim point2D4 As GeometricElement
Set point2D4 = geometricElements1.Item(5)

Dim long11 As Long
long11 = point2D4.GeometricType

Dim long12 As Long
long12 = point2D4.GeometricType

Dim boolean4 As Boolean
boolean4 = point2D4.Construction

Dim bSTR9 As String
bSTR9 = point2D4.Name


Dim axisSystems1 As AxisSystems
Set axisSystems1 = part1.AxisSystems

Dim axisSystem2 As AxisSystem
Set axisSystem2 = axisSystems1.Add()

axisSystem2.OriginType = catAxisSystemOriginByPoint

Dim reference1 As Reference
Set reference1 = selectedElement3.Reference

Dim bSTR10 As String
bSTR10 = reference1.Name

Dim bSTR11 As String
bSTR11 = sketch1.Name

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(Sketch.1;4);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)

axisSystem2.OriginPoint = reference2

Dim arrayOfVariantOfDouble1(2)
arrayOfVariantOfDouble1(0) = 1.000000
arrayOfVariantOfDouble1(1) = 0.000000
arrayOfVariantOfDouble1(2) = 0.000000
Dim arrayOfVariantOfDouble2(2)
arrayOfVariantOfDouble2(0) = 0.000000
arrayOfVariantOfDouble2(1) = 1.000000
arrayOfVariantOfDouble2(2) = 0.000000
axisSystem2.PutVectors arrayOfVariantOfDouble1, arrayOfVariantOfDouble2

part1.UpdateObject axisSystem2

axisSystem2.IsCurrent = False

Dim axisSystem3 As AxisSystem
Set axisSystem3 = axisSystems1.Add()

axisSystem3.OriginType = catAxisSystemOriginByPoint

Dim reference3 As Reference
Set reference3 = selectedElement4.Reference

Dim bSTR12 As String
bSTR12 = reference3.Name

Dim bSTR13 As String
bSTR13 = sketch1.Name

Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(Sketch.1;3);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)

axisSystem3.OriginPoint = reference4

Dim arrayOfVariantOfDouble3(2)
arrayOfVariantOfDouble3(0) = 1.000000
arrayOfVariantOfDouble3(1) = 0.000000
arrayOfVariantOfDouble3(2) = 0.000000
Dim arrayOfVariantOfDouble4(2)
arrayOfVariantOfDouble4(0) = 0.000000
arrayOfVariantOfDouble4(1) = 1.000000
arrayOfVariantOfDouble4(2) = 0.000000
axisSystem3.PutVectors arrayOfVariantOfDouble3, arrayOfVariantOfDouble4

part1.UpdateObject axisSystem3

axisSystem3.IsCurrent = False

Dim axisSystem4 As AxisSystem
Set axisSystem4 = axisSystems1.Add()

axisSystem4.OriginType = catAxisSystemOriginByPoint

Dim reference5 As Reference
Set reference5 = selectedElement5.Reference

Dim bSTR14 As String
bSTR14 = reference5.Name

Dim bSTR15 As String
bSTR15 = sketch1.Name

Dim reference6 As Reference
Set reference6 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(Sketch.1;2);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)

axisSystem4.OriginPoint = reference6

Dim arrayOfVariantOfDouble5(2)
arrayOfVariantOfDouble5(0) = 1.000000
arrayOfVariantOfDouble5(1) = 0.000000
arrayOfVariantOfDouble5(2) = 0.000000
Dim arrayOfVariantOfDouble6(2)
arrayOfVariantOfDouble6(0) = 0.000000
arrayOfVariantOfDouble6(1) = 1.000000
arrayOfVariantOfDouble6(2) = 0.000000
axisSystem4.PutVectors arrayOfVariantOfDouble5, arrayOfVariantOfDouble6

part1.UpdateObject axisSystem4

axisSystem4.IsCurrent = False

Dim axisSystem5 As AxisSystem
Set axisSystem5 = axisSystems1.Add()

axisSystem5.OriginType = catAxisSystemOriginByPoint

Dim reference7 As Reference
Set reference7 = selectedElement6.Reference

Dim bSTR16 As String
bSTR16 = reference7.Name

Dim bSTR17 As String
bSTR17 = sketch1.Name

Dim reference8 As Reference
Set reference8 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(Sketch.1;1);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)

axisSystem5.OriginPoint = reference8

Dim arrayOfVariantOfDouble7(2)
arrayOfVariantOfDouble7(0) = 1.000000
arrayOfVariantOfDouble7(1) = 0.000000
arrayOfVariantOfDouble7(2) = 0.000000
Dim arrayOfVariantOfDouble8(2)
arrayOfVariantOfDouble8(0) = 0.000000
arrayOfVariantOfDouble8(1) = 1.000000
arrayOfVariantOfDouble8(2) = 0.000000
axisSystem5.PutVectors arrayOfVariantOfDouble7, arrayOfVariantOfDouble8

part1.UpdateObject axisSystem5

axisSystem5.IsCurrent = False

selection1.Clear 

part1.Update 

End Sub

但我想要点数轴。如果我有 5 个点，它将使 5 个或 100 个点连接到 100 个轴。就像一个循环

Answer 1

您没有使用 selection1.Search 找到的元素。您必须循环选定的元素。

此外，您从选择中获得的 BrepString 对于创建参考无效。这个字符串必须修改（我在catia论坛上找到的）。

这里是循环创建参考和轴系统的示例：

Sub CATMain()

Dim oPartDoc As Document
Dim oPart As Part
Dim oAxisSystems As AxisSystems
Dim oSel as Selection
Dim oRef as Reference
Dim oAxisSystem as AxisSystem
Dim Status as String
Dim sFilter() as String
Dim i as Integer
Dim oSketch as Sketch

Set oPartDoc = CATIA.ActiveDocument
Set oPart = oPartDoc.Part
Set oAxisSystems = oPart.AxisSystems
Set oSel = oPartDoc.Selection

'select the sketch
Redim sFilter(0)
sFilter(0) = "Sketch"

Status = oSel.SelectElement2(sFilter, "Select a sketch", False)

if Status = "Cancel" Then Exit Sub

Set oSketch = oSel.Item2(1).Value

'search for vertex in the sketch
oSel.Search "Topology.CGMVertex,sel"

'create axissystems
if oSel.Count2 <> 0 Then
    for i = 1 to oSel.Count2
        Set oRef = oPart.CreateReferenceFromBRepName(GetBrepName(oSel.Item2(i).value.Name), oSketch)
        Set oAxisSystem = oAxisSystems.Add()
        oAxisSystem.OriginType = catAxisSystemOriginByPoint
        oAxisSystem.OriginPoint = oRef
    next
    oPart.Update
end if

oPart.Update 

End Sub

'Code: maybe from COE forum
'modifies string from selected element to BREP string for CreateReferenceFromBRepName

Private Function GetBrepName(MyBRepName As String) As String
    MyBRepName = Replace(MyBRepName, "Selection_", "")
    MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
    MyBRepName = MyBRepName & ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
    GetBrepName = MyBRepName
End Function