穴軸とパイプ面作成マクロ[Type B]｜CATIAマクロの作成方法

今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

●プロダクトファイル開いた状態で
　ツリーにぶら下がっているパートをアクティブにしてマクロを実行させたいです。
　
②穴軸とパイプ面作成　タイプB
　　選択　　　　　　　　　　　　　　　　　　　　　
　　　点を選択　＆　サーフェスを選択　（選択の点は選択するサーフェス上です。）　
　　　↓
　　結果　　　　　
　　　選択したサーフェスの面直線作成　と　作成された線に対してスイープ（中心と半径）
　
　・　A、Bの軸線及び面直線は点から両端で作成　（例　始点-10mmm,終点10mm)
　・　線片側長さとスイープ直径はダイアログで数値を入力　
      （線片側長さは10と入力すれば始点-10mmm,終点10mm　全長は20mm,　
　　　スイープは入力時には直径の数値を入れたいです。）
　・　作成された線やスイープは作成後に履歴により寸法変更もしたいです。

複数のマクロ案を頂いたので、それぞれ別ページでまとめていきます。
(上記お問い合わせ内容に番号やタイプがついているのは複数案頂いたためです)

今回のマクロはユーザーが選択したオブジェクトを使って形状を作成するだけなので、作り方さえわかれば他の形状作成系マクロもすぐに使いこなせるようになります。

またCATProduct上で実行することを想定していますが、これにはちょっとしたテクニックが必要になるのでぜひここで押さえておきましょう。

※本ページの内容は「穴軸とパイプ面作成マクロ[Type A]」とほとんど同じです。
　コピペ部分もあるのでTypeAを理解している方は、流し読みでも理解できると思います。

マクロの機能

今回作成したマクロは
『ユーザーが選択した点とサーフェスに対して軸線とパイプ面を作成するマクロ』です。

具体的な機能は以下のとおりです。

サンプルコード

マクロのサンプルコードは以下のとおりです。

Option Explicit

Sub CATMain()

    Dim SEL
    Set SEL = CATIA.ActiveDocument.Selection
    
    Dim filter1
    Dim filter2
    Dim Msg As String
    Dim status As String
    
label1:
    
    filter1 = Array("Face")
    Msg = "サーフェス(フェース)を選択してください。"
    
    status = SEL.SelectElement2(filter1, Msg, False)
    If status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
    Dim SelSurf As AnyObject
    Set SelSurf = SEL.Item(1).Value.Parent

    SEL.Clear

    filter2 = Array("Point")
    Msg = "点を選択して下さい。"
    
    status = SEL.SelectElement2(filter2, Msg, False)
    If status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
    Dim SelPoint As Point
    Set SelPoint = SEL.Item(1).Value
    
    SEL.Clear
    
    'SELPointを含むCATPart(PartDocumrnt)を取得
    
    Dim tmp_Obj
    Set tmp_Obj = SelPoint
    
    Do Until TypeName(tmp_Obj) = "PartDocument"
        Set tmp_Obj = tmp_Obj.Parent
    Loop
    
    Dim DOC As PartDocument
    Set DOC = tmp_Obj
        
    Dim PT As Part
    Set PT = DOC.Part
    
    
    '選択された点がサーフェスに乗っているか確認
    
    Dim RefPoint As Reference
    Dim RefSurf As Reference
    
    Set RefPoint = PT.CreateReferenceFromObject(SelPoint)
    Set RefSurf = PT.CreateReferenceFromObject(SelSurf)
    
    Dim SPA As Workbench
    Set SPA = DOC.GetWorkbench("SPAWorkbench")
    
    Dim ConfMeasure
    Set ConfMeasure = SPA.GetMeasurable(RefPoint)
    
    Dim getvalue As Variant
    getvalue = ConfMeasure.GetMinimumDistance(RefSurf)
    
    If getvalue <> 0 Then
        MsgBox "選択した点がサーフェスに乗っていません。" & vbLf & "選択し直してください。"
        GoTo label1
    End If
    
    Dim UserLength As String
    UserLength = InputBox("軸線の長さを入力して下さい。", "長さ入力", 10)
    If UserLength = "" Then
        Exit Sub
    End If
    
    Dim UserDiameter As String
    UserDiameter = InputBox("パイプ面の直径を入力して下さい。", "直径入力", 5)
    If UserDiameter = "" Then
        Exit Sub
    End If
    
    Dim HB As HybridBody
    Set HB = PT.HybridBodies.Add
    HB.Name = "穴軸とパイプ面作成(タイプB)"
    
    Dim HSF As HybridShapeFactory
    Set HSF = PT.HybridShapeFactory
    
    
    '① 選択された点を通り、サーフェスに直交な直線を作成
    
    Dim NormLine As HybridShapeLineNormal
    Set NormLine = HSF.AddNewLineNormal(RefSurf, RefPoint, UserLength, -1 * UserLength, False)
    
    HB.AppendHybridShape NormLine
    PT.Update

    
    '② ①を中心とするスイープを作成
    
    Dim RefLine As Reference
    Set RefLine = PT.CreateReferenceFromObject(NormLine)
    
    Dim PipeSweep As HybridShapeSweepCircle
    Set PipeSweep = HSF.AddNewSweepCircle(RefLine)
    
    PipeSweep.Mode = 6
    PipeSweep.SmoothActivity = False
    PipeSweep.GuideDeviationActivity = False
    PipeSweep.SetRadius 1, UserDiameter / 2
    PipeSweep.SetbackValue = 0.02
    PipeSweep.FillTwistedAreas = 1
    PipeSweep.C0VerticesMode = True
    
    HB.AppendHybridShape PipeSweep
    PT.Update
    
End Sub

コード解説

形状作成部分のコードは基本的に以下の①〜③を繰り返すだけなのでここでは割愛します。
① 形状の取得
② 取得した形状のReferenceを作成
③ ReferenceとHybridShapeFactoryを使って形状作成

以下では形状作成を行うまでのドキュメントの定義方法、ユーザー選択オブジェクトの確認などの形状作成部分以外のコードを解説していきます。
　

ドキュメントの定義

まずはドキュメントの定義を行います。
通常は「Set DOC = CATIA.ActiveDocument」のように1行で済ませることのできる「ドキュメントの定義」ですが、お問い合わせの内容によると「プロダクトファイル開いた状態でツリーにぶら下がっているパートをアクティブにしてマクロを実行させたいです。」とのことです。この場合、アクティブドキュメントはCATPartではなくCATProductになってしまうので、単純に「Set DOC = CATIA.ActiveDocument」と書いてしまうと以降の処理でCATPartの処理を行うことができません。

というわけでここでは少し違う方法を使ってドキュメント(CATPart)を定義していきます。

    Dim SEL
    Set SEL = CATIA.ActiveDocument.Selection
    
    Dim filter1
    Dim filter2
    Dim Msg As String
    Dim status As String
    
label1:
    
    filter1 = Array("Face")
    Msg = "サーフェス(フェース)を選択してください。"
    
    status = SEL.SelectElement2(filter1, Msg, False)
    If status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
    Dim SelSurf As AnyObject
    Set SelSurf = SEL.Item(1).Value.Parent

    SEL.Clear

    filter2 = Array("Point")
    Msg = "点を選択して下さい。"
    
    status = SEL.SelectElement2(filter2, Msg, False)
    If status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
    Dim SelPoint As Point
    Set SelPoint = SEL.Item(1).Value
    
    SEL.Clear
    
    'SELPointを含むCATPart(PartDocumrnt)を取得
    
    Dim tmp_Obj
    Set tmp_Obj = SelPoint
    
    Do Until TypeName(tmp_Obj) = "PartDocument"
        Set tmp_Obj = tmp_Obj.Parent
    Loop
    
    Dim DOC As PartDocument
    Set DOC = tmp_Obj

まずはドキュメントの定義はせず、ユーザーに「SelectElement2」を使ってサーフェスと点を選択させます。

次にこの点(サーフェスでも可)の親オブジェクトを順々に見ていき、PartDocumentオブジェクトになった時に、そのオブジェクトをドキュメントとして定義します。(コードでいうと「Do〜Loop」の部分)

点を選択し親オブジェクトを見ていくと
Point ＜ HybridShapes ＜ HybridBody ＜ HybridBodies ＜ Part ＜ PartDocument
といった具合に、必ず「PartDocument」が見つかります。

つまり「Until TypeName(tmp_Obj) = “PartDocument"」と条件をつければ、いつかはPartDocumentオブジェクトを取得できるというわけです。
実際に下のツリー構造で見てもCATPartを扱うPartDocumentオブジェクトは最上位のオブジェクトなので、親を順々に見ていけば必ず見つけることができるということがわかります。

ユーザーが選択した点とサーフェスが接しているかを確認

次にユーザーが選択した点とサーフェスが"接しているか"を確認していきます。
冒頭のお問い合わせ内容には記載されていませんが点とサーフェスは接していることが前提とのことなので、ここで両オブジェクトが接しているかを確認し、接していない場合は再度ユーザー選択のフェーズに戻るようにしておきます。

    Dim RefPoint As Reference
    Dim RefSurf As Reference
    
    Set RefPoint = PT.CreateReferenceFromObject(SelPoint)
    Set RefSurf = PT.CreateReferenceFromObject(SelSurf)
    
    Dim SPA As Workbench
    Set SPA = DOC.GetWorkbench("SPAWorkbench")
    
    Dim ConfMeasure
    Set ConfMeasure = SPA.GetMeasurable(RefPoint)
    
    Dim getvalue As Variant
    getvalue = ConfMeasure.GetMinimumDistance(RefSurf)
    
    If getvalue <> 0 Then
        MsgBox "選択した点がサーフェスに乗っていません。" & vbLf & "選択し直してください。"
        GoTo label1
    End If

上記のコードでは「Measurableオブジェクト」の「GetMinimumDistancerメソッド」を使って、ユーザーが選択した点とサーフェスの最短距離を取得しています。

ここで取得した値が「0」の場合は、両オブジェクトが接していることを意味します。
というわけでIf文で「If getvalue <> 0 Then」とすれば、接していない場合の条件を表すことができるので、この中の処理で前項の「label1:」に処理を飛ばすようにしています。

ユーザーが選択した点とサーフェスが接している場合は以降で形状作成の処理を行います。
この部分は初めにもいった通り、同じような処理の繰り返しなので割愛します。
(コードのコメント文を見れば何をやっているかある程度理解できると思います)

まとめ

今回は「選択された点に穴軸線とパイプ面を作成するマクロ」についての内容でした。

TypeAの内容をそのまま流用して、一部を変更しているだけなので1度見たことのある内容があったと思います。基本的に同じようなマクロはコードを少し書き換えるだけで簡単に機能を変更できるので、本サイトのサンプルマクロをうまく使って自分に合わせたマクロに書き換えて見てください。

目次へ戻る
 

icon-book CATIAマクロを本気で勉強するなら

Vb Scripting for Catia V5: How to Program Catia Macros

created by Rinker

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング

CATIA V5: Macro Programming with Visual Basic Script

created by Rinker

McGraw-Hill Education

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング