CATDrawingでコーナー部に仮想線を作成するマクロ｜CATIAマクロの作成方法
今回は「マクロ案」より頂いた内容です。
送って頂いた内容は以下の通りです。
ワークベンチ:
ドラフティング（メカニカル・デザイン）マクロ案:
丸みのある形状には、丸みを施す以前の形状を仮想線（実線細線）を作成して、寸法を記入します。
仮想線をマクロで作図することは可能でしょうか？
まとめると下図のようにコーナーをつける前の”角の状態”を仮想線で作成したいということですね。
※“丸み”の定義が曖昧のため、ここでは「円弧」ということで進めていきます。
マクロの機能
今回作成したマクロは上図のとおり、「選択したビュー内のすべてのコーナー(円弧)に仮想線を作成する」というものです。
具体的な機能は以下のとおりです。
マクロの機能まとめ ・選択したビュー内のコーナーすべてに仮想線を付与する(円弧のみに対応)
・選択したビューに鍵がかかっている場合、鍵を外して処理を続けるか確認する
・選択したビューに鍵がかかっている場合、鍵を外して処理を続けるか確認する
※注意※
本マクロではコーナーに仮想線を作成するといっていますが、
処理の内容としては「選択したビュー内のすべての円弧に接線となる2つの直線を作成する」というものになっています。
つまり、コーナーではない部分に円弧があったとしても、その円弧に対して仮想線が作成されてしまいます。(形状の角部分を認識しているわけではないということ)
要は「円弧があれば、その円弧に対して仮想線を作るマクロ」だと思ってもらえれば大丈夫です。
仮想線を作成するプログラムの考え方は問題ないはずなので、使用環境に合わせて条件などを追加すればもう少し使い勝手の良いマクロになると思います。
サンプルコード
マクロのコードは以下のとおりです。
マクロ実行後、ビューを選択するとそのビュー内のコーナーに仮想線が作成されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 |
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の作成
|
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
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 '分離したビューをアクティブに(このビューが以降のマクロの作業空間となります) |
この部分では仮想線を作成するための作業場所となる「TempView」を作成しています。
「ユーザーが選択したビュー内ですべての処理をすればいいのでは？」とも思いますが、本マクロではビュー内の「円」を取得して処理を行っていくためビューの分離が必要です。(以下の[Tips]参照)
しかし、ユーザーが選択したビューを分離してしまうと3D形状とのリンクが切れてしまうため図面データとして問題があります。というわけで、ここではユーザーが選択したビューを複製し、それを分離することでこれらの問題を解決させています。
最終的にはTempView内で作った仮想線をユーザーが選択したビューにコピペします。
全ての処理が終わったらTempViewは削除するといった流れになります。
[Tips] 投影ビューの分離
CATDrawingのマクロを作成するときに一番厄介なのが、3D形状から投影された2D形状です。
投影された2D形状はどんな形をしていようが「DrawingView」として取得されてしまいます。
この投影された2D形状を通常の円弧や直線のように扱うには、そのビューを分離する必要があります。ビューを分離すると以下のようにそれぞれの線を「円」や「直線」のようにタイプ別で取得することができます。
直線方程式を使って仮想線を作成
|
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 |
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つとして参考程度に見て頂ければ幸いです。
※より詳細なコード解説が必要な方は「お問い合わせ」よりご連絡下さい。
CATIAマクロを本気で勉強するなら
