曲線を交差しているエレメント毎に分割するマクロ｜CATIAマクロの作成方法

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

ワークベンチ: GSDワークベンチ

マクロ案:
長い曲線に対して、交差している曲線が複数有、長い曲線を交差している部分で分割し細かくしたいのですが、分割すると次回の分割時に長い曲線が分割されて複数有る状態なのでどれが交差している長い曲線か分かりません。
出来れば、形状２つ作成し１つは分割する用の曲線を入れもう一つに交差する曲線を入れて総当たりで分割するマクロは出来ないでしょうか？

文字と合わせて画像もご連絡していただきましたが、イメージとしては下画像のような長い曲線(白)と短い曲線(ﾋﾟﾝｸ)があり、交差しているところで長い曲線(白)を分割したいという感じです。つまり下画像でいえば、長い曲線(白)を交差しているところで3つに分割する処理をしたいということです。

この処理は「分割(Split)する向き」「どこで分割するか」「分割する要素となる短い曲線はどれを使うか」などをすべてプログラム上で認識させないといけないため、サンプルコードの内容は少し難解なものとなっています。

人間の目で見れば簡単な処理ですが、プログラムで書こうとすると実はハードルの高い処理です。
(上画像の長い曲線を3分割にするという処理だけでもなかなかの難易度だと思います。)

1. マクロの機能
2. サンプルコード
3. コード解説
4. まとめ

マクロの機能

今回作成したのは選択した2つの形状セット内の曲線と曲線が交差しているところで分割した曲線を出力するマクロです。
言葉だけだとわかりづらいですが冒頭でも紹介した通り、長い曲線を短い曲線で細かく分割して出力する処理を行います。(上画像の場合、[曲線.3]は5分割され、[曲線.4]は3分割されています)

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

マクロの機能まとめ・選択した2つの形状セット内の曲線と曲線が交差しているところで分割する
※「長い曲線が入った形状セット」→「短い曲線が入った形状セット」の順で選択
・分割した曲線はデータム化(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

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

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

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

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で分割することができます。また、分割方向を反転するには最後の引数を「１」から「-１」にします。

分割(Split)の作成

Dim spl As HybridShapeSplit
Set spl = HybridShapeFactoryオブジェクト.AddNewHybridSplit(ref1, ref2, 1)

あとは上記コードを使って長い曲線を短い曲線で分割していけばいいだけのお話ですが、そう単純にいかないのが今回の難しいところです。

たとえば下のような長い曲線(水色)と短い曲線(ﾋﾟﾝｸ)があるとします。
短い曲線が下画像の①～⑥の順番、もしくは⑥～①の順番で並んでいれば、端のものから順番に分割していけば問題なく作成できます。

しかし、選択する形状セット内にある短い曲線が上画像の通り、端から順番になっていないことを考えるとその処理ではうまく処理ができません。

そこで本マクロでは「分割した後の長い曲線と交差する”交差点の数”と”分割後の曲線の端点”の総和をカウントする」という考えで処理を行っています。

たとえば下図のように④の曲線で分割した場合を考えると、「分割後の曲線と交差する点の数」と「分割後の曲線の端点」の総和は左側が5つ(赤4+緑1)、右側が4つ(黄色3+緑1)となります。

これを先ほどの考えて同じように「端から順に分割していく」という処理にするには「分割後の曲線と交差する点の数」と「分割後の曲線の端点」の総和が「２」となる曲線を採用していけばいいという訳です

たとえば上図のように⑥で分割した場合、交差点と端点の総和が2となる場合、そちら側の曲線は採用して形状として作成します。

そのときにあわせて反対側に分割した曲線も一緒に作成します。
あとはその反対側に分割した曲線に対しても同じ処理をしていけば徐々に分割していくことができ、最終的にすべてをキレイに分割することができます。

サンプルコードではこのような考えで処理が行われています。
データム化する前で処理を止めれば測定用の形状履歴も確認できるので、詳しく理解したい方はそちらもチェックしてみてください。

まとめ

今回は形状セットの面積を測定し基準値以下の場合は色を付けるマクロについての内容でした。

正直なところ、コード解説を読んでもあまり理解できないと思う方も多いと思います。
というのももっと素直で単純なコードでもできるのではないかと疑いたくなるような処理となってしまっているためです。

分割自体はコード解説のところでも紹介した通りAddNewHybridSplitメソッドを使えば作成できるので、もっと簡単な処理で作成できないかいろいろ試してみて下さい。
　

サンプルマクロ集に戻る
 目次へ戻る

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

2021年10月21日2022年7月28日CATIA, CATIAマクロ

Posted by Lic