読者です 読者をやめる 読者になる 読者になる

C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

指定した要素の同一形状セット内に、対称形状を作成する

ご質問頂いたもののサンプルです。

ユーザーが指定した要素(点・線・面等)をZX平面を基準とした対称要素を、
指定した要素と同一の形状セット内に作成します。
仮に、以下の様な状態のファイルがあるとします。
f:id:kandennti:20150812131525p:plain

ここでマクロを実行し、"曲線.1" "サーフェス.1" "点.1" をShiftやCtrlキーを利用して
複数選択します。
その際、"Selection.SelectElement2" では現れなかった "ツールパレット" と言う
ダイアログが表示されますので、一番右の "完了" を押す事で選択完了となります。
f:id:kandennti:20150812131531p:plain

ZX平面を基準とした対称要素が、データム化された状態で追加されます。
f:id:kandennti:20150812131539p:plain

ソースコードです。

'vba
'CreateSymmetryDatum
Dim Part As Part '作業中Part
Dim HSFact As HybridShapeFactory '作業中HybridShapeFactory

Sub CATMain()
    Call CreateSymmetryDatumMain
End Sub

Sub CreateSymmetryDatumMain()
    '準備
    Dim Doc As Document
    Set Doc = CATIA.ActiveDocument
    
    Dim Selection1 'As Selection
    Set Selection1 = Doc.Selection
    
    'ユーザー選択
    Dim InputObjectType(0) As Variant
    Dim SelectHybridShapes As New Collection
    InputObjectType(0) = "HybridShape"
    With Selection1
        .Clear
        Result = .SelectElement3(InputObjectType, "形状セットを選択して下さい // [Esc]=キャンセル", True, CATMultiSelTriggWhenUserValidatesSelection, False)
        If Result = "Cancel" Then Exit Sub
        For i = 1 To .Count
            Call SelectHybridShapes.Add(.Item(i).Value)
        Next
        .Clear
    End With
    
    '対称作成
    Dim HShape As HybridShape
    For Each HShape In SelectHybridShapes
        Call CreateSymmetryDatum(HShape)
    Next
End Sub

Private Sub CreateSymmetryDatum(HS As HybridShape)
    '選択要素のPartを取得
    Set Part = GetPart(HS)

    '選択要素のPartと形状セット取得
    Dim HBody As HybridBody
    Select Case TypeName(HS.Parent)
        Case "Parameters"
            'データム
            Set HBody = GetHybridBodyDatum(HS, Part.HybridBodies)
        Case Else
            '非データム
            Set HBody = HS.Parent '無理やり取得できる
    End Select
    
    'HybridShapeFactory更新
    Set HSFact = Part.HybridShapeFactory
    
    '対称基準面取得
    Dim BasePlaneRef As Reference
    Set BasePlaneRef = Part.CreateReferenceFromObject(Part.OriginElements.PlaneZX)
    
    '対称データム作成
    Dim Datum As AnyObject
    Set Datum = CreateDatum(CreateSymmetry(HS, BasePlaneRef))
    
    '形状セットに登録
    Call HBody.AppendHybridShape(Datum)
End Sub

'HybridShapeからPartの取得
Private Function GetPart(OJ As AnyObject) As Part
    If TypeName(OJ.Parent) = "Part" Then
        Set GetPart = OJ.Parent
    Else
        Set GetPart = GetPart(OJ.Parent)
    End If
End Function

'データム要素から所属する形状セットの取得
Private Function GetHybridBodyDatum(HS As HybridShape, HBs As HybridBodies) As HybridBody
    Dim HB As HybridBody
    Dim HSha As HybridShape
    
    For Each HB In HBs
        For Each HSha In HB.HybridShapes
            'If HSha Is HS Then 'これではNG
            If HSha.Name = HS.Name Then
                Set GetHybridBodyDatum = HB
                Exit Function
            End If
        Next
        If GetHybridBodyDatum Is Nothing Then
            Set GetHybridBodyDatum = GetHybridBodyDatum(HS, HB.HybridBodies)
        Else
            Exit For
        End If
    Next
End Function

'Symmetry
Private Function CreateSymmetry(ItemRef As Reference, PlaneRef As Reference) As Reference
    Dim Symmetry As HybridShapeSymmetry
    Set Symmetry = HSFact.AddNewSymmetry(ItemRef, PlaneRef)
    Symmetry.VolumeResult = False
    Call Part.UpdateObject(Symmetry)
    Set CreateSymmetry = Part.CreateReferenceFromObject(Symmetry)
End Function

'Datum
Private Function CreateDatum(Ref As Reference) As AnyObject
    Dim Datum As AnyObject
    Select Case HSFact.GetGeometricalFeatureType(Ref)
        Case 1 'Point
            Set Datum = HSFact.AddNewPointDatum(Ref)
        Case 2 'Curve
            Set Datum = HSFact.AddNewCurveDatum(Ref)
        Case 3 'Line
            Set Datum = HSFact.AddNewLineDatum(Ref)
        Case 4 'Circle
            Set Datum = HSFact.AddNewCircleDatum(Ref)
        Case 5 'Surface
            Set Datum = HSFact.AddNewSurfaceDatum(Ref)
        Case 6 'Plane
            Set Datum = HSFact.AddNewPlaneDatum(Ref)
        Case 7 'Volume
            Set Datum = HSFact.AddNewVolumeDatum(Ref)
    End Select
    Call Part.UpdateObject(Datum)
    Set CreateDatum = Datum
    Call HSFact.DeleteObjectForDatum(Ref)
End Function

・このマクロは、ProductでもPart単体でも実行可能です。
・Product上でマクロを使用し、選択要素が異なるPartで複数選択されていても
 それぞれの形状セット以下に作成されます。
・上記の例ではデータム化された要素でしたが、データム化されていないものでも
 処理が可能です。(作成される対称要素は、データム化されます)


対称要素を、選択された要素と同一の形状セットに作成する為、形状セットを取得
しなければならないのですが、データム化されていないもの(履歴付き)は簡単です。
しかしデータム化された要素は、何処の形状セットに入っているのか?を探し出す
必要があります。(同じ方法では取得できません)
その為、Partファイル内の全ての形状セットを巡回し、探し出しています。
その際、オブジェクト同士の比較 "Is演算子" を利用してみたのですが、
上手く行かない事があった為、表示されている名前で同一か?をチェックしています。

Private Function GetHybridBodyDatum(HS As HybridShape, HBs As HybridBodies) As HybridBody
    Dim HB As HybridBody
    Dim HSha As HybridShape
    
    For Each HB In HBs
        For Each HSha In HB.HybridShapes
            'If HSha Is HS Then 'これではNG
            If HSha.Name = HS.Name Then
	・
	・

その為、同一の名前の要素がPartファイル内にある場合、意図した形状セット内に
対称要素が作成されない可能性があります。