CATDrawingでコーナー部に仮想線を作成するマクロ｜CATIAマクロの作成方法

今回は「マクロ案」より頂いた内容です。
送って頂いた内容は以下の通りです。

ワークベンチ: 
ドラフティング（メカニカル・デザイン）

マクロ案: 
丸みのある形状には、丸みを施す以前の形状を仮想線（実線細線）を作成して、寸法を記入します。
仮想線をマクロで作図することは可能でしょうか？

　
まとめると下図のようにコーナーをつける前の”角の状態”を仮想線で作成したいということですね。
※“丸み”の定義が曖昧のため、ここでは「円弧」ということで進めていきます。

 

マクロの機能

今回作成したマクロは上図のとおり、「選択したビュー内のすべてのコーナー(円弧)に仮想線を作成する」というものです。

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

 icon-wrench マクロの機能まとめ ・選択したビュー内のコーナーすべてに仮想線を付与する(円弧のみに対応)
・選択したビューに鍵がかかっている場合、鍵を外して処理を続けるか確認する

※注意※
本マクロではコーナーに仮想線を作成するといっていますが、
処理の内容としては「選択したビュー内のすべての円弧に接線となる2つの直線を作成する」というものになっています。

つまり、コーナーではない部分に円弧があったとしても、その円弧に対して仮想線が作成されてしまいます。(形状の角部分を認識しているわけではないということ)
要は「円弧があれば、その円弧に対して仮想線を作るマクロ」だと思ってもらえれば大丈夫です。

仮想線を作成するプログラムの考え方は問題ないはずなので、使用環境に合わせて条件などを追加すればもう少し使い勝手の良いマクロになると思います。

 

サンプルコード

マクロのコードは以下のとおりです。
マクロ実行後、ビューを選択するとそのビュー内のコーナーに仮想線が作成されます。

Option Explicit

Sub CATMain()

Dim DRWDOC As DrawingDocument
If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
    MsgBox "CATDrawingに切り替えてから実行して下さい。"
    Exit Sub
End If

Set DRWDOC = CATIA.ActiveDocument

Dim SPA As Workbench
Set SPA = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

Dim SEL 'As Selection
Set SEL = DRWDOC.Selection
SEL.Clear

Dim filter
filter = Array("DrawingView")

Dim Msg As String
Msg = "補助線を付与するビューを選択して下さい。"

Dim Status As String
Status = SEL.SelectElement2(filter, Msg, False)
If Status <> "Normal" Then
    MsgBox "キャンセルしました。"
    Exit Sub
End If

Dim SELView As DrawingView
Set SELView = SEL.Item(1).Value

If Str(SELView.LockStatus) = "True" Then
    Dim Response As Integer
    Dim Msg2 As String
    Msg2 = "選択したビューはロックがかかっています。" & vbLf & "ロックを外して実行してもよろしいですか？"
    Response = MsgBox(Msg2, vbYesNo + vbInformation)
    If Response = 7 Then
        MsgBox "キャンセルします。"
        Exit Sub
    ElseIf Response = 6 Then
        SELView.LockStatus = False
    End If
End If

With SEL
    .Clear
    .Add SELView
    .Copy
    .Clear
    .Add SELView.Parent.Parent
    .Paste
End With

Dim TempView As DrawingView
Set TempView = SEL.Item(1).Value
TempView.Name = "補助線作成用ビュー　※残っていたら削除してください"

Dim Fac2D As Factory2D
Set Fac2D = TempView.Factory2D

TempView.Isolate
TempView.Activate
SEL.Clear
SEL.Add TempView

SEL.Search ("ﾄﾞﾗﾌﾃｨﾝｸﾞ.円,sel")

If SEL.Count = 0 Then
    MsgBox "該当のエレメントが見つからないため中断します。"
    Exit Sub
End If

Dim i As Integer
Dim Arcs As Collection
Set Arcs = New Collection

For i = 1 To SEL.Count
    Arcs.Add SEL.Item(i).Value    '選択をコレクションに一時保管
Next i

Dim j As Integer

Dim Arc 'As Curve2D             '円弧(正円も含む)
Dim ArcStartPoint 'As Point2D　 '円弧の始点
Dim ArcEndPoint 'As Point2D     '円弧の終点
Dim ArcStartPointCoord(1)       '円弧の始点座標 (0)がX座標 (1)がY座標
Dim ArcEndPointCoord(1)         '円弧の終点座標 (0)がX座標 (1)がY座標
Dim ArcCTRPointCoord(2)         '円弧の中心点座標 (0)がX座標 (1)がY座標 (2)がZ座標
                                '※Measurableオブジェクトで取得するためZ座標分も用意しておく必要がある(Z座標は使用しませんが)

Dim Counter As Integer
Counter = 0

Dim Lines As Collection
Set Lines = New Collection

For j = 1 To Arcs.Count
  
    Set Arc = Arcs.Item(j)
    Set ArcStartPoint = Arc.StartPoint
    Set ArcEndPoint = Arc.EndPoint
    ArcStartPoint.GetCoordinates ArcStartPointCoord
    ArcEndPoint.GetCoordinates ArcEndPointCoord
  
    Dim MeasureCTR 'As Measurable
    Set MeasureCTR = SPA.GetMeasurable(Arc)
    MeasureCTR.GetCenter ArcCTRPointCoord

    If (ArcStartPointCoord(0) <> ArcEndPointCoord(0)) And (ArcStartPointCoord(1) <> ArcEndPointCoord(1)) Then  '円弧の始点と終点が一致していない場合(=正円ではなく円弧の場合)
    '円弧の場合のみ以下の処理 正円の場合は無視
        Dim x1 As Double
        Dim y1 As Double
        Dim x2 As Double
        Dim y2 As Double
        Dim x3 As Double
        Dim y3 As Double
        
        x1 = ArcStartPointCoord(0)  '円弧の始点のX座標
        y1 = ArcStartPointCoord(1)  '円弧の始点のY座標
        x2 = ArcEndPointCoord(0)    '円弧の終点のX座標
        y2 = ArcEndPointCoord(1)    '円弧の終点のY座標
        x3 = ArcCTRPointCoord(0)    '円弧の中心点のX座標
        y3 = ArcCTRPointCoord(1)    '円弧の中心点のY座標
        
        Dim CornorPointX As Double
        Dim CornorPointY As Double
        
        Dim LineEqua1
        Dim LineEqua2
        Dim LineEqua3
        Dim LineEqua4
        
        If Format(x1, "0.000") = Format(x3, "0.000") Then
            LineEqua3 = PtoP_Line(x2, y2, x3, y3)
            CornorPointY = y1
            If LineEqua3(0) = 0 Then
                CornorPointX = x2
            Else
                LineEqua4 = Normal_Line(x2, y2, LineEqua3(0), LineEqua3(1))
                CornorPointX = (y1 - LineEqua4(1)) / LineEqua4(0)
                Debug.Print "BBBBB"
            End If
        ElseIf Format(x2, "0.000") = Format(x3, "0.000") Then
            LineEqua1 = PtoP_Line(x1, y1, x3, y3)
            CornorPointY = y2
            If LineEqua1(0) = 0 Then
                CornorPointX = x1
            Else
                LineEqua2 = Normal_Line(x1, y1, LineEqua1(0), LineEqua1(1))
                CornorPointX = (y2 - LineEqua2(1)) / LineEqua2(0)
            End If
        Else
            LineEqua1 = PtoP_Line(x1, y1, x3, y3)
            LineEqua2 = Normal_Line(x1, y1, LineEqua1(0), LineEqua1(1))
            LineEqua3 = PtoP_Line(x2, y2, x3, y3)
            LineEqua4 = Normal_Line(x2, y2, LineEqua3(0), LineEqua3(1))
            
            CornorPointX = (-LineEqua2(1) + LineEqua4(1)) / (LineEqua2(0) - LineEqua4(0))
            CornorPointY = LineEqua2(0) * CornorPointX + LineEqua2(1)

        End If
 
        Dim LineSTR As Line2D
        Set LineSTR = Fac2D.CreateLine(CornorPointX, CornorPointY, x1, y1)
        
        Dim LineEND As Line2D
        Set LineEND = Fac2D.CreateLine(CornorPointX, CornorPointY, x2, y2)
        
        Lines.Add LineSTR
        Lines.Add LineEND
        
        Counter = Counter + 1
        
    End If

Next j

Dim k As Integer
With SEL
    .Clear
    For k = 1 To Lines.Count
        .Add Lines.Item(k)
    Next k
    .Copy
    .Clear
    .Add SELView
    .Paste
    .Clear
    .Add TempView
    .Delete
End With

If Counter = 0 Then
    MsgBox "終了します。"
Else
    MsgBox "補助線の作成が完了しました。"
End If
     
End Sub
'------------------------------------------------------------------------------------------------
'************************************************************************
'
'  関数内容：点(x1,y1)と点(x2,y2)を通る直線の傾きと切片を求める
'
'　引数　　：x1 , y1 , x2 , y2
'　戻り値　：傾き(Slope) ,  切片(Intercept)
'
'*************************************************************************

Private Function PtoP_Line(x1, y1, x2, y2)

Dim Slope
Dim SlopeX
Dim SlopeY
Dim Intercept

SlopeX = x2 - x1
SlopeY = y2 - y1

If SlopeX <> 0 Then
    Slope = SlopeY / SlopeX
    Intercept = (Slope * x1) - x2
End If

PtoP_Line = Array(Slope, Intercept)

End Function
'------------------------------------------------------------------------------------------------
'************************************************************************
'
'  関数内容：点(x1,y1)を通り、直線Xに対して垂直な直線の傾きと切片を求める
'
'　引数　　：x1 , y1 , 直線Xの傾き(Slope) , 直線Xの切片(Intercept)
'　戻り値　：傾き(NormalSlope) ,  切片(NormalIntercept)
'
'*************************************************************************

Private Function Normal_Line(x1, y1, Slope, Intercept)

Dim NormalSlope
Dim NormalIntercept

If Slope <> 0 Then
    NormalSlope = -1 / Slope
    NormalIntercept = y1 - (NormalSlope * x1)
End If
    
Normal_Line = Array(NormalSlope, NormalIntercept)

End Function


　

コード解説

非常に長いコードなので重要部分を抜粋して解説していきます。

コード内に簡単な説明も記しているのでコード内コメントも確認ください。
　

TempViewの作成

Option Explicit

Sub CATMain()

Dim DRWDOC As DrawingDocument
If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
    MsgBox "CATDrawingに切り替えてから実行して下さい。"
    Exit Sub
End If

Set DRWDOC = CATIA.ActiveDocument

Dim SPA As Workbench
Set SPA = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

Dim SEL 'As Selection
Set SEL = DRWDOC.Selection
SEL.Clear

Dim filter
filter = Array("DrawingView")

Dim Msg As String
Msg = "補助線を付与するビューを選択して下さい。"

Dim Status As String
Status = SEL.SelectElement2(filter, Msg, False)
If Status <> "Normal" Then
    MsgBox "キャンセルしました。"
    Exit Sub
End If

Dim SELView As DrawingView
Set SELView = SEL.Item(1).Value

If Str(SELView.LockStatus) = "True" Then　'SELViewのロックがかかっている場合
    Dim Response As Integer
    Dim Msg2 As String
    Msg2 = "選択したビューはロックがかかっています。" & vbLf & "ロックを外して実行してもよろしいですか？"
    Response = MsgBox(Msg2, vbYesNo + vbInformation)
    If Response = 7 Then　　　　　　　 '「いいえ」が押された時
        MsgBox "キャンセルします。"
        Exit Sub
    ElseIf Response = 6 Then　　　　　'「はい」が押された時
        SELView.LockStatus = False  'ロックを解除
    End If
End If

With SEL
    .Clear
    .Add SELView
    .Copy　　　　　　　　　　　　　　 'SELViewの複製
    .Clear
    .Add SELView.Parent.Parent　　'SELView.Parent.Parent → SELViewがあるシート
    .Paste　　　　　　　　　　　　　　'SELViewと同じシートに複製を貼り付け
End With

Dim TempView As DrawingView
Set TempView = SEL.Item(1).Value　　　　　　　　　　　　　　　　　　　'SELViewの複製を[TempView]に入れる
TempView.Name = "補助線作成用ビュー　※残っていたら削除してください"　　'最終的にこのビューは消すため、エラーで削除できなかったとき用に名前の変更

Dim Fac2D As Factory2D
Set Fac2D = TempView.Factory2D

TempView.Isolate　　'コピーしたビューを分離
TempView.Activate  '分離したビューをアクティブに(このビューが以降のマクロの作業空間となります)
SEL.Clear
SEL.Add TempView

この部分では仮想線を作成するための作業場所となる「TempView」を作成しています。
「ユーザーが選択したビュー内ですべての処理をすればいいのでは？」とも思いますが、本マクロではビュー内の「円」を取得して処理を行っていくためビューの分離が必要です。(以下の[Tips]参照)

しかし、ユーザーが選択したビューを分離してしまうと3D形状とのリンクが切れてしまうため図面データとして問題があります。というわけで、ここではユーザーが選択したビューを複製し、それを分離することでこれらの問題を解決させています。

最終的にはTempView内で作った仮想線をユーザーが選択したビューにコピペします。
全ての処理が終わったらTempViewは削除するといった流れになります。
　

 [Tips] 投影ビューの分離  

CATDrawingのマクロを作成するときに一番厄介なのが、3D形状から投影された2D形状です。
投影された2D形状はどんな形をしていようが「DrawingView」として取得されてしまいます。
　

 

この投影された2D形状を通常の円弧や直線のように扱うには、そのビューを分離する必要があります。ビューを分離すると以下のようにそれぞれの線を「円」や「直線」のようにタイプ別で取得することができます。
 

 

 

直線方程式を使って仮想線を作成

Option Explicit

Sub CATMain()

Dim DRWDOC As DrawingDocument
If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
    MsgBox "CATDrawingに切り替えてから実行して下さい。"
    Exit Sub
End If

Set DRWDOC = CATIA.ActiveDocument

Dim SPA As Workbench
Set SPA = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

Dim SEL 'As Selection
Set SEL = DRWDOC.Selection
SEL.Clear

Dim filter
filter = Array("DrawingView")

Dim Msg As String
Msg = "補助線を付与するビューを選択して下さい。"

Dim Status As String
Status = SEL.SelectElement2(filter, Msg, False)
If Status <> "Normal" Then
    MsgBox "キャンセルしました。"
    Exit Sub
End If

Dim SELView As DrawingView
Set SELView = SEL.Item(1).Value

If Str(SELView.LockStatus) = "True" Then
    Dim Response As Integer
    Dim Msg2 As String
    Msg2 = "選択したビューはロックがかかっています。" & vbLf & "ロックを外して実行してもよろしいですか？"
    Response = MsgBox(Msg2, vbYesNo + vbInformation)
    If Response = 7 Then
        MsgBox "キャンセルします。"
        Exit Sub
    ElseIf Response = 6 Then
        SELView.LockStatus = False
    End If
End If

With SEL
    .Clear
    .Add SELView
    .Copy
    .Clear
    .Add SELView.Parent.Parent
    .Paste
End With

Dim TempView As DrawingView
Set TempView = SEL.Item(1).Value
TempView.Name = "補助線作成用ビュー　※残っていたら削除してください"

Dim Fac2D As Factory2D
Set Fac2D = TempView.Factory2D

TempView.Isolate
TempView.Activate
SEL.Clear
SEL.Add TempView

SEL.Search ("ﾄﾞﾗﾌﾃｨﾝｸﾞ.円,sel")

If SEL.Count = 0 Then
    MsgBox "該当のエレメントが見つからないため中断します。"
    Exit Sub
End If

Dim i As Integer
Dim Arcs As Collection
Set Arcs = New Collection

For i = 1 To SEL.Count
    Arcs.Add SEL.Item(i).Value    '選択をコレクションに一時保管
Next i

Dim j As Integer

Dim Arc 'As Curve2D             '円弧(正円も含む)
Dim ArcStartPoint 'As Point2D　 '円弧の始点
Dim ArcEndPoint 'As Point2D     '円弧の終点
Dim ArcStartPointCoord(1)       '円弧の始点座標 (0)がX座標 (1)がY座標
Dim ArcEndPointCoord(1)         '円弧の終点座標 (0)がX座標 (1)がY座標
Dim ArcCTRPointCoord(2)         '円弧の中心点座標 (0)がX座標 (1)がY座標 (2)がZ座標
                                '※Measurableオブジェクトで取得するためZ座標分も用意しておく必要がある(Z座標は使用しませんが)

Dim Counter As Integer
Counter = 0

Dim Lines As Collection
Set Lines = New Collection

For j = 1 To Arcs.Count
  
    Set Arc = Arcs.Item(j)
    Set ArcStartPoint = Arc.StartPoint
    Set ArcEndPoint = Arc.EndPoint
    ArcStartPoint.GetCoordinates ArcStartPointCoord
    ArcEndPoint.GetCoordinates ArcEndPointCoord
  
    Dim MeasureCTR 'As Measurable
    Set MeasureCTR = SPA.GetMeasurable(Arc)
    MeasureCTR.GetCenter ArcCTRPointCoord

    If (ArcStartPointCoord(0) <> ArcEndPointCoord(0)) And (ArcStartPointCoord(1) <> ArcEndPointCoord(1)) Then  '円弧の始点と終点が一致していない場合(=正円ではなく円弧の場合)
    '円弧の場合のみ以下の処理 正円の場合は無視
        Dim x1 As Double
        Dim y1 As Double
        Dim x2 As Double
        Dim y2 As Double
        Dim x3 As Double
        Dim y3 As Double
        
        x1 = ArcStartPointCoord(0)  '円弧の始点のX座標
        y1 = ArcStartPointCoord(1)  '円弧の始点のY座標
        x2 = ArcEndPointCoord(0)    '円弧の終点のX座標
        y2 = ArcEndPointCoord(1)    '円弧の終点のY座標
        x3 = ArcCTRPointCoord(0)    '円弧の中心点のX座標
        y3 = ArcCTRPointCoord(1)    '円弧の中心点のY座標
        
        Dim CornorPointX As Double
        Dim CornorPointY As Double
        
        Dim LineEqua1
        Dim LineEqua2
        Dim LineEqua3
        Dim LineEqua4
        
        If Format(x1, "0.000") = Format(x3, "0.000") Then
            LineEqua3 = PtoP_Line(x2, y2, x3, y3)
            CornorPointY = y1
            If LineEqua3(0) = 0 Then
                CornorPointX = x2
            Else
                LineEqua4 = Normal_Line(x2, y2, LineEqua3(0), LineEqua3(1))
                CornorPointX = (y1 - LineEqua4(1)) / LineEqua4(0)
                Debug.Print "BBBBB"
            End If
        ElseIf Format(x2, "0.000") = Format(x3, "0.000") Then
            LineEqua1 = PtoP_Line(x1, y1, x3, y3)
            CornorPointY = y2
            If LineEqua1(0) = 0 Then
                CornorPointX = x1
            Else
                LineEqua2 = Normal_Line(x1, y1, LineEqua1(0), LineEqua1(1))
                CornorPointX = (y2 - LineEqua2(1)) / LineEqua2(0)
            End If
        Else
            LineEqua1 = PtoP_Line(x1, y1, x3, y3)
            LineEqua2 = Normal_Line(x1, y1, LineEqua1(0), LineEqua1(1))
            LineEqua3 = PtoP_Line(x2, y2, x3, y3)
            LineEqua4 = Normal_Line(x2, y2, LineEqua3(0), LineEqua3(1))
            
            CornorPointX = (-LineEqua2(1) + LineEqua4(1)) / (LineEqua2(0) - LineEqua4(0))
            CornorPointY = LineEqua2(0) * CornorPointX + LineEqua2(1)

        End If
 
        Dim LineSTR As Line2D
        Set LineSTR = Fac2D.CreateLine(CornorPointX, CornorPointY, x1, y1)
        
        Dim LineEND As Line2D
        Set LineEND = Fac2D.CreateLine(CornorPointX, CornorPointY, x2, y2)
        
        Lines.Add LineSTR
        Lines.Add LineEND
        
        Counter = Counter + 1
        
    End If

Next j

本コードのメイン部分です。(関数部分は省略)
細かい内容は割愛して何を行っているかを簡単に説明していきます。

まず、上図のうち「Point1(円弧の始点)」「Point2(円弧の中心)」「Point3(円弧の終点)」の3点の座標は「StartPoint」「EndPoint」などの既存のプロパティ/メソッドですべて求めることができます。

今回のマクロで欲しい値は「Point4」の座標です。
「Point4」の座標がわかれば、あとは「Point4とPoint1を結ぶ直線」と「Point4とPoint3を結ぶ直線」の２つの直線を作成すればそれが今回作りたい仮想線となります。

「Point4」の座標は既存のプロパティ/メソッドだけでは取得できないので計算で求めていきます。
「Point1」「Point2」「Point3」の座標を使って「Point4」の座標を求める方法は以下のとおりです。上記コードでは以下の内容をプログラム上で行っているだけです。

① 「Point1」と「Point2」を通る「LineA」の直線方程式を求める
② 「Point3」と「Point2」を通る「LineB」の直線方程式を求める
③ 「Point1」を通り「LineA」と垂直な「LineC」の直線方程式を求める
④ 「Point3」を通り「LineB」と垂直な「LineD」の直線方程式を求める

⑤ 「LineC」と「LineD」の交点座標を求める

※①,②  二点を通る直線の方程式 (外部サイト)
　③,④  垂直な直線の方程式の求め方 (外部サイト)
　⑤　  ２直線の交点を求める公式 (外部サイト)

　
上記の内容で1つの円弧に対して仮想線を作成することができます。
あとはTempView内のすべての円弧に対してループで仮想線を作成していくだけです。

 

まとめ

今回はCATDrawingのコーナー部に仮想線を作成するマクロについての内容でした。

マクロ自体は実行可能ですが、複雑なビューになるほど動作が重くなります。
あくまでもマクロ作成の考え方の1つとして参考程度に見て頂ければ幸いです。

※より詳細なコード解説が必要な方は「お問い合わせ」よりご連絡下さい。
　

目次へ戻る
 

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

Vb Scripting for Catia V5: How to Program Catia Macros
created by Rinker
CATIA V5: Macro Programming with Visual Basic Script
created by Rinker
McGraw-Hill Education

 

2024年8月26日CATIA,CATIAマクロ