曲線を交差しているエレメント毎に分割するマクロ｜CATIAマクロの作成方法
今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ: GSDワークベンチ
マクロ案:
長い曲線に対して、交差している曲線が複数有、長い曲線を交差している部分で分割し細かくしたいのですが、分割すると次回の分割 時に長い曲線が分割されて複数有る状態なのでどれが交差している 長い曲線か分かりません。
出来れば、形状２つ作成し１つは分割する用の曲線を入れもう一つに交差する曲線を入れて総当たりで分割するマクロは出来ないでし ょうか？
文字と合わせて画像もご連絡していただきましたが、イメージとしては下画像のような長い曲線(白)と短い曲線(ﾋﾟﾝｸ)があり、交差しているところで長い曲線(白)を分割したいという感じです。つまり下画像でいえば、長い曲線(白)を交差しているところで3つに分割する処理をしたいということです。
この処理は「分割(Split)する向き」「どこで分割するか」「分割する要素となる短い曲線はどれを使うか」などをすべてプログラム上で認識させないといけないため、サンプルコードの内容は少し難解なものとなっています。
人間の目で見れば簡単な処理ですが、プログラムで書こうとすると実はハードルの高い処理です。
(上画像の長い曲線を3分割にするという処理だけでもなかなかの難易度だと思います。)
マクロの機能
今回作成したのは選択した2つの形状セット内の曲線と曲線が交差しているところで分割した曲線を出力するマクロです。
言葉だけだとわかりづらいですが冒頭でも紹介した通り、長い曲線を短い曲線で細かく分割して出力する処理を行います。(上画像の場合、[曲線.3]は5分割され、[曲線.4]は3分割されています)
具体的な機能は以下のとおりです。
※「長い曲線が入った形状セット」→「短い曲線が入った形状セット」の順で選択
・分割した曲線はデータム化(Isolate)して出力
・Part直下に「CurveCutMacro」という形状セットが作成されその中に出力していく
・分割された曲線は長い曲線ごとにセット分けされて「CurveCut-X」という名前で出力
サンプルコード
マクロのコードは以下のとおりです。
コードがかなり長いのですべての詳しい解説はしませんが、コード解説では「どのような考えの処理をしているか」について説明していきます。
Option Explicit
Sub CATMain()
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "このマクロはPartDocument専用です。" & vbLf & _
"CATPartに切り替えて実行してください。"
Exit Sub
End If
Dim doc As PartDocument: Set doc = CATIA.ActiveDocument
Dim pt As Part: Set pt = doc.Part
Dim hsf As HybridShapeFactory: Set hsf = pt.HybridShapeFactory
Dim sel: Set sel = doc.Selection
sel.Clear
'形状ｾｯﾄ(長い曲線)を取得
Dim res As String
Dim Filter: Filter = Array("HybridBody")
res = sel.SelectElement2(Filter, "長い曲線の入った形状ｾｯﾄを選択してください。", False)
If res <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim input_hb1 As HybridBody
Set input_hb1 = sel.Item(1).Value
sel.Clear
'形状ｾｯﾄ(短い曲線)を取得
res = sel.SelectElement2(Filter, "短い曲線の入った形状ｾｯﾄを選択してください。", False)
If res <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim input_hb2 As HybridBody
Set input_hb2 = sel.Item(1).Value
sel.Clear
'作業用形状ｾｯﾄの作成
Dim output_hb As HybridBody
Set output_hb = pt.HybridBodies.Add
output_hb.Name = "CurveCutMacro"
Dim p
Dim ps As Collection
Dim hs1 As HybridShape
Dim hs2 As HybridShape
Dim ref_hs1 As Reference
Dim ref_hs2 As Reference
Dim crv
Dim chk
Dim spl1 As HybridShapeSplit
Dim spl2 As HybridShapeSplit
Dim ref_p As Reference
Dim ref_spl As Reference
Dim ref_crv As Reference
Dim output As Collection
'長い曲線ﾙｰﾌﾟ
For Each hs1 In input_hb1.HybridShapes
Set ref_hs1 = pt.CreateReferenceFromObject(hs1)
Dim crv_hb As HybridBody
Set crv_hb = output_hb.HybridBodies.Add
crv_hb.Name = hs1.Name
Dim p_hb As HybridBody
Set p_hb = crv_hb.HybridBodies.Add
p_hb.Name = "point"
'短い曲線ﾙｰﾌﾟ 総当たりで全ての交差(Intersection)作成
For Each hs2 In input_hb2.HybridShapes
Set ref_hs2 = pt.CreateReferenceFromObject(hs2)
Dim sect As HybridShapeIntersection
Set sect = hsf.AddNewIntersection(ref_hs1, ref_hs2)
p_hb.AppendHybridShape sect
On Error Resume Next
pt.UpdateObject sect
If Err.Number = -2147467259 Then
sel.Add sect
sel.Delete
End If
On Error GoTo 0
sect.Name = hs1.Name & " & " & hs2.Name
Next hs2
'全ての交差と始点,終点をｺﾚｸｼｮﾝ「ps」に格納
Set ps = New Collection
For Each p In p_hb.HybridShapes
ps.Add p
Next p
'始点の作成
Dim sp As Point
Set sp = hsf.AddNewPointOnCurveFromPercent(ref_hs1, 0, False)
p_hb.AppendHybridShape sp
pt.UpdateObject sp
sp.Name = "Start Point"
'終点の作成
Dim ep As Point
Set ep = hsf.AddNewPointOnCurveFromPercent(ref_hs1, 1, False)
p_hb.AppendHybridShape ep
pt.UpdateObject ep
ep.Name = "End Point"
Dim spa As SPAWorkbench
Dim m As Measurable
Dim md As Double
Dim ref_sp As Reference
Dim ref_ep As Reference
Dim p_chk As Boolean
Dim p_cnt As Long
Dim omit_p
Dim omit_ps As Collection
Set spa = doc.GetWorkbench("SPAWorkbench")
Set omit_ps = New Collection
Set ref_sp = pt.CreateReferenceFromObject(sp)
Set ref_ep = pt.CreateReferenceFromObject(ep)
'始点と全ての交差の距離を測定し,距離が0の場合は「omit_ps」に格納
Set m = spa.GetMeasurable(ref_sp)
For Each p In ps
Set ref_p = pt.CreateReferenceFromObject(p)
md = m.GetMinimumDistance(ref_p)
If md = 0 Then
p_chk = True
omit_ps.Add p
End If
Next p
'終点と全ての交差の距離を測定し,距離が0の場合は「omit_ps」に格納
Set m = spa.GetMeasurable(ref_ep)
For Each p In ps
Set ref_p = pt.CreateReferenceFromObject(p)
md = m.GetMinimumDistance(ref_p)
If md = 0 Then
p_chk = True
omit_ps.Add p
End If
Next p
If p_chk = True And ps.Count = 1 Then
sel.Add output_hb
sel.Delete
MsgBox "形状を作成できません。"
Exit Sub
End If
'「omit_ps」内に入っている交差を「ps」内から除外
lab:
p_cnt = 1
For Each p In ps
For Each omit_p In omit_ps
If p.Name = omit_p.Name Then
ps.Remove p_cnt
GoTo lab
End If
Next omit_p
p_cnt = p_cnt + 1
Next p
'始点と終点を「ps」に格納
'→ 始点,終点,交差(始点,終点と同じ位置にある交差は除く)の入ったｺﾚｸｼｮﾝ
ps.Add sp
ps.Add ep
'分割(Split)格納用形状ｾｯﾄを作成
Dim spl_hb As HybridBody
Set spl_hb = crv_hb.HybridBodies.Add
spl_hb.Name = "split"
Set output = New Collection
Set ref_crv = ref_hs1
'分割(Split)の作成
If ps.Count > 2 Then
On Error Resume Next
Do
For Each p In ps
Set ref_p = pt.CreateReferenceFromObject(p)
Set spl1 = hsf.AddNewHybridSplit(ref_crv, ref_p, 1)
spl_hb.AppendHybridShape spl1
pt.UpdateObject spl1
'交差している点の数をｶｳﾝﾄ
chk = 0
chk = GetSectPointsCount(spl1, ps)
'交差している点の数が2つの場合の分割(Split)以外は削除
If chk = 2 Then
output.Add spl1
Set spl2 = hsf.AddNewHybridSplit(ref_crv, ref_p, -1)
spl_hb.AppendHybridShape spl2
pt.UpdateObject spl2
If spl_hb.HybridShapes.Count = (ps.Count - 1) * 2 - 2 Then
output.Add spl2
End If
Exit For
Else
sel.Add spl1
sel.Delete
End If
Next p
Set crv = spl_hb.HybridShapes.Item(spl_hb.HybridShapes.Count)
Set ref_crv = pt.CreateReferenceFromObject(crv)
Loop Until output.Count = ps.Count - 1
On Error GoTo 0
'ｱｳﾄﾌﾟｯﾄのﾃﾞｰﾀﾑ(Datum)作成
Dim cnt As Long
cnt = 1
For Each crv In output
Set ref_crv = pt.CreateReferenceFromObject(crv)
Dim dtm_crv
Set dtm_crv = hsf.AddNewCurveDatum(ref_crv)
crv_hb.AppendHybridShape dtm_crv
pt.UpdateObject dtm_crv
dtm_crv.Name = "CurveCut-" & cnt
cnt = cnt + 1
Next crv
sel.Add p_hb
sel.Add spl_hb
sel.Delete
Else
sel.Add crv_hb
sel.Delete
End If
Next hs1
End Sub
'****************************************************************************
' 関数内容：ｺﾚｸｼｮﾝ「ps」内のpointとcrvの交差している数をｶｳﾝﾄして返す
'****************************************************************************
Function GetSectPointsCount(ByVal crv As HybridShape, ByVal ps As Collection) As Long
Dim doc As PartDocument: Set doc = CATIA.ActiveDocument
Dim pt As Part: Set pt = doc.Part
Dim spa As Workbench
Dim m As Measurable
Dim md As Double
Dim p
Dim ref_p As Reference
Dim ref_crv As Reference
Dim cnt As Long
Set spa = doc.GetWorkbench("SPAWorkbench")
Set ref_crv = pt.CreateReferenceFromObject(crv)
Set m = spa.GetMeasurable(ref_crv)
For Each p In ps
Set ref_p = pt.CreateReferenceFromObject(p)
md = m.GetMinimumDistance(ref_p)
If md = 0 Then
cnt = cnt + 1
End If
Next p
GetSectPointsCount = cnt
End Function
コード解説
本マクロでは分割(Split)がメイン処理です。
という訳でまずは分割を作成する方法を紹介しておきます。
VBAで分割を作成するにはHybridShapeFactoryオブジェクトのAddNewHybridSplitメソッドを使い、以下のように書きます。下記コードによりref1をref2で分割することができます。また、分割方向を反転するには最後の引数を「１」から「-１」にします。
Dim spl As HybridShapeSplit
Set spl = HybridShapeFactoryオブジェクト.AddNewHybridSplit(ref1, ref2, 1)
あとは上記コードを使って長い曲線を短い曲線で分割していけばいいだけのお話ですが、そう単純にいかないのが今回の難しいところです。
たとえば下のような長い曲線(水色)と短い曲線(ﾋﾟﾝｸ)があるとします。
短い曲線が下画像の①～⑥の順番、もしくは⑥～①の順番で並んでいれば、端のものから順番に分割していけば問題なく作成できます。
しかし、選択する形状セット内にある短い曲線が上画像の通り、端から順番になっていないことを考えるとその処理ではうまく処理ができません。
そこで本マクロでは「分割した後の長い曲線と交差する"交差点の数"と"分割後の曲線の端点"の総和をカウントする」という考えで処理を行っています。
たとえば下図のように④の曲線で分割した場合を考えると、「分割後の曲線と交差する点の数」と「分割後の曲線の端点」の総和は左側が5つ(赤4+緑1)、右側が4つ(黄色3+緑1)となります。
これを先ほどの考えて同じように「端から順に分割していく」という処理にするには「分割後の曲線と交差する点の数」と「分割後の曲線の端点」の総和が「２」となる曲線を採用していけばいいという訳です
たとえば上図のように⑥で分割した場合、交差点と端点の総和が2となる場合、そちら側の曲線は採用して形状として作成します。
そのときにあわせて反対側に分割した曲線も一緒に作成します。
あとはその反対側に分割した曲線に対しても同じ処理をしていけば徐々に分割していくことができ、最終的にすべてをキレイに分割することができます。
サンプルコードではこのような考えで処理が行われています。
データム化する前で処理を止めれば測定用の形状履歴も確認できるので、詳しく理解したい方はそちらもチェックしてみてください。
まとめ
今回は形状セットの面積を測定し基準値以下の場合は色を付けるマクロについての内容でした。
正直なところ、コード解説を読んでもあまり理解できないと思う方も多いと思います。
というのももっと素直で単純なコードでもできるのではないかと疑いたくなるような処理となってしまっているためです。
分割自体はコード解説のところでも紹介した通りAddNewHybridSplitメソッドを使えば作成できるので、もっと簡単な処理で作成できないかいろいろ試してみて下さい。
CATIAマクロを本気で勉強するなら
