クリックしたｽｹｯﾁ点にHVの拘束を付ける

何となく、近い将来必要に迫られる気がしたので、作りました。
スケッチャーWB時のみ、クリックしたスケッチの点に原点からHとVの
拘束を付けます。

'vba 選択したｽｹｯﾁの点にHVの拘束を作成  using-'KCL0.0.12'

Sub CATMain()
    'ﾜｰｸﾍﾞﾝﾁﾁｪｯｸ
    If Not CATIA.GetWorkbenchId = "CS0WKS" Then
        MsgBox "ｽｹｯﾁ作業中のみ使用できます"
        Exit Sub
    End If
    
    'ﾓﾛﾓﾛ取得
    Dim skt As Sketch
    Set skt = GetActiveSketch()
    
    Dim ax2d As Axis2D
    Set ax2d = skt.AbsoluteAxis
    
    Dim cons As Constraints
    Set cons = skt.Constraints
    
    Dim pt As Part
    Set pt = KCL.GetParent_Of_T(skt, "PartDocument").Part
    
    Dim refH As Reference
    Set refH = pt.CreateReferenceFromObject(ax2d.HorizontalReference)
    
    Dim refV As Reference
    Set refV = pt.CreateReferenceFromObject(ax2d.VerticalReference)
    
    '選択準備
    Dim sel As Variant ' Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    Dim filter As Variant
    filter = Array("Point2D")
    
    Dim msg As String
    msg = "点を選択 / ESC=ｷｬﾝｾﾙ"

    Dim refP As Reference
    
    '選択
    Do
        sel.Clear
        Select Case sel.SelectElement2(filter, msg, False)
            Case "Cancel", "Undo", "Redo"
                Exit Sub
        End Select
        Set refP = sel.Item(1).Reference
        Call InitConstraint(refP, refH, refV, cons)
    Loop
End Sub

'拘束作成
Private Sub InitConstraint(ByVal refP As Reference, _
                           ByVal refH As Reference, _
                           ByVal refV As Reference, _
                           ByVal cons As Constraints)
    Dim con(1) As Constraint
    With cons
        Set con(0) = .AddBiEltCst(catCstTypeDistance, refH, refP)
        Set con(1) = .AddBiEltCst(catCstTypeDistance, refV, refP)
    End With
    
    Dim i As Long
    For i = 0 To UBound(con)
        If Not con(i).Status = catCstStatusOK Then
            Call RemoveConstraint(con(i))
        End If
    Next
End Sub

'拘束削除
Private Sub RemoveConstraint(ByVal con As Constraint)
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    With sel
        .Clear
        .Add con
        .Delete
    End With
End Sub

'ｱｸﾃｨﾌﾞなｽｹｯﾁ取得
Private Function GetActiveSketch() As Sketch
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    Dim skt As Sketch
    
    With sel
        Call .Clear
        Call .Search("CATPrtSearch.Sketch,in")
        Set skt = .Item(1).value
        Call .Clear
    End With
    Set GetActiveSketch = skt
End Function

突貫で作ったのでちょっと雑です。

スケッチの点は "自動寸法拘束" が付かないんですよね。

付かなくて正解なんですけど。(恐らく邪魔)

過拘束も新たに作成しようとしている分はﾁｪｯｸしています。

方向反転判断しながら平行曲線作成

"GSDのサポートを指定した平行曲線ﾏｸﾛが上手く行かない" とご相談頂きました。
こんな感じでしょうか？

まず、実際にﾏｸﾛの記録を取ってみます。

'catvba
Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 As hybridBodies
Set hybridBodies1 = part1.hybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("形状ｾｯﾄ.1")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapeExtract1 As HybridShapeExtract
Set hybridShapeExtract1 = hybridShapes1.Item("抽出.1")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("BorderREdge:(BEdge:(Brp:(FeatureRSUR.1;(Brp:(Pad.1;0:(Brp:(Sketch.1;3)));Brp:(Pad.1;2)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeExtract1)

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeExtract1)

Dim hybridShapeCurvePar1 As HybridShapeCurvePar
Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)

hybridShapeCurvePar1.SmoothingType = 0

hybridBody1.AppendHybridShape hybridShapeCurvePar1

part1.InWorkObject = hybridShapeCurvePar1

part1.Update

End Sub

細かくﾁｪｯｸしているのが面倒な為、個人的には記録をとったﾏｸﾛを再実行します。
同様の結果になれば、全て記録されている目安になります。

これ全てが欲しい訳ではなく、実際に欲しい部分は、こちらの3行です。

Dim hybridShapeCurvePar1 As HybridShapeCurvePar
Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)

hybridShapeCurvePar1.SmoothingType = 0

個人的には問題を切り分けたい為、この平行曲線を作成するだけの関数を作成します。

Private Function InitCurvePar(xxxx) As HybridShapeCurvePar
    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

出来上がった平行曲線のﾘﾌｧﾚﾝｽを取得し戻り値とするのも方法ですが、とりあえず
ｵﾌﾞｼﾞｪｸﾄそのものを返すことにしました。
xxxx部分は必要となる引数です。必要となるものは "Set hybridShapeCurvePar1～"
の行に比較的有ります。
・hybridShapeFactory1
・reference1
・reference2
・7#（距離）
この辺でしょうか。

これらを引数としますが、"reference1" の名称ではあまりにも意味がわかりにくいため
それなりの名称に変更します。

Private Function InitCurvePar(ByVal part1 As Part, _
                              ByVal edgeRef As Reference, _
                              ByVal supportRef As Reference, _
                              ByVal leng As Double) As HybridShapeCurvePar
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(edgeRef, supportRef, leng, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    part1.UpdateObject hybridShapeCurvePar1
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

ﾏｸﾛの記録をとった場合は、"part1.Update" で記録されますが、
"part1.UpdateObject"　の方が処理も軽いですし、他のｴﾗｰの影響も受けません。
（手動のﾛｰｶﾙ更新と同等です）

質問者さんが悩まれているのは、ここからです。
実際はｵﾌｾｯﾄ方向がｻﾎﾟｰﾄ上にならない場合があります。
そのような場合、手動であれば "方向を反転" を押す事になりますよね？

HybridShapeCurveParｵﾌﾞｼﾞｪｸﾄを調べてみると、それっぽいﾌﾟﾛﾊﾟﾃｨが有ります。

英語わからないのですが、それっぽい事には気が付きます。

これを "On Error Resume Next" を利用しながら判断し処理するように
書き換えました。

Private Function InitCurvePar(ByVal part1 As Part, _
                              ByVal edgeRef As Reference, _
                              ByVal supportRef As Reference, _
                              ByVal leng As Double) As HybridShapeCurvePar
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(edgeRef, supportRef, leng, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    On Error Resume Next
        err.Number = 0
        part1.UpdateObject hybridShapeCurvePar1
        
        '反転
        If Not err.Number = 0 Then
            err.Number = 0
            hybridShapeCurvePar1.InvertDirection = True
            part1.UpdateObject hybridShapeCurvePar1
        End If
        
        '反転してもｴﾗｰの為、そもそも無理
        If Not err.Number = 0 Then
             Set hybridShapeCurvePar1 = Nothing
        End If
    On Error GoTo 0
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

同じ事を複数書いたりしてますが、わかりやすくする為にこのようにしました。
（個人的にはもっと書き直したいです）

この自作関数を呼び出す為に、最初に記録したﾏｸﾛをこんな感じで
書き換えます。

    ・・・

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    'Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)
    
    'hybridShapeCurvePar1.SmoothingType = 0
    
    '自作関数処理
    Set hybridShapeCurvePar1 = InitCurvePar(part1, reference1, reference2, 7#)
    
    '両側失敗
    If hybridShapeCurvePar1 Is Nothing Then
        MsgBox "ｵﾌｾｯﾄ距離が思わしく有りません!"
        Exit Sub
    End If
    
    hybridBody1.AppendHybridShape hybridShapeCurvePar1
    
    part1.InWorkObject = hybridShapeCurvePar1
    
    part1.Update

End Sub

InitCurveParの4番目の引数を　"-7#" "1000#" 等試して頂ければ、それなりの
処理をしてくれます。

変数名もｲﾏｲﾁなのですが、とりあえず僕が進める手順はこの様な感じです。

選択面の抽出

「抽出を行いたいが、選択面のみにならずに全体の面になってしまう」
と、ご相談を頂きました。

面の選択の際のﾌｨﾙﾀｰの問題かと思ったのですが、どうやら違うようです。
こちらで確認した所、これであれば選択面のみの抽出が出来ています。

'vba
Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄ等
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As part
    Set pt = doc.part
    
    '選択
    Dim msg As String
    msg = "面選択"
    
    Dim filter As Variant
    filter = Array("Face")
    
    Dim sel As Variant ' Selection
    Set sel = doc.Selection
    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Sub
    End Select
    
    'ﾘﾌｧﾚﾝｽ取得
    Dim selectFace As AnyObject
    Set selectFace = sel.Item(1).Reference
    
    '抽出
    Dim face As AnyObject
    Set face = InitExtract(pt, selectFace)
    
    '形状ｾｯﾄ作成・挿入
    Dim hb As HybridBody
    Set hb = pt.hybridBodies.Add()
    
    hb.AppendHybridShape face
    
    MsgBox "Done"
End Sub

'抽出
Private Function InitExtract(ByVal pt As part, ByVal ref As Reference) _
                    As HybridShapeExtract
    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory
    
    Dim hybridShapeExtract1 As HybridShapeExtract
    Set hybridShapeExtract1 = fact.AddNewExtract(ref)
    
    hybridShapeExtract1.PropagationType = 3
    hybridShapeExtract1.ComplementaryExtract = False
    hybridShapeExtract1.IsFederated = False
    
    pt.UpdateObject hybridShapeExtract1
    Set InitExtract = hybridShapeExtract1
End Function

今回はSelectionからReferenceを取得してそのまま抽出する際の
Referenceとして使えましたが、場合によってはBrapﾈｰﾑから
Referenceを取得しなければならない場合もあるかも知れません。

「ｻﾌﾞﾂﾘｰ」ｺﾏﾝﾄﾞ

ﾏｸﾛで「ｻﾌﾞﾂﾘｰを開く」を行いたい　と御質問を頂きました。
結論を先に書くと出来なさそうです。が、その他調べた事を覚書しておきます。

今まで利用した事が無かったのですが、ﾒﾆｭｰの「表示」内に「ｻﾌﾞﾂﾘｰ」が
あるのを知りませんでした。

試した所、ちょっと不思議な感じがしました。

CATIAを起動し新たにPartを作成した状態では、こんな感じでｸﾞﾚｰｱｳﾄしてます。

これを利用する為には、一度ｺﾝﾃｷｽﾄﾒﾆｭｰの「ｻﾌﾞﾂﾘｰを開く」を実行すると
ﾁｪｯｸが入った状態で利用できます。

ｸﾘｯｸするとﾁｪｯｸが外れ、全てのｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳが消えます。

続いて新たにPartを作ります。
最初は利用できない状態ですが、一度ｺﾝﾃｷｽﾄﾒﾆｭｰの「ｻﾌﾞﾂﾘｰを開く」を実行します。
ここでﾒﾆｭｰからではなく、ｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳの×印をクリックし閉じます。

ここでﾒﾆｭｰを見ると、ｸﾞﾚｰｱｳﾄしてます。

先程とは状態が異なります。

ｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳの×印をクリックした場合は、実際にｳｨﾝﾄﾞｳを閉じていて
ﾒﾆｭｰの「ｻﾌﾞﾂﾘｰ」はｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳ全てを表示/非表示操作しているのだろう
と思われます。
（最初とX印で閉じた場合、表示/非表示に関わらずｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳが無い為
　ｺﾏﾝﾄﾞ自体が利用できない）

こんな制限付きの「ｻﾌﾞﾂﾘｰ」ｺﾏﾝﾄﾞであれば、こちらで利用可能です。

 '日本語
 CATIA.StartCommand ("ｻﾌﾞﾂﾘｰ")
 '英語
 CATIA.StartCommand ("Sub-Trees")

但し、ｻﾌﾞﾂﾘｰｳｨﾝﾄﾞｳが開いていても、CATIA.Windows.Countは変化無く
実際に開かれているのか？開かれていないのか？　はﾏｸﾛで判断する事も
難しそうです。（WinAPIでｺﾞﾘｺﾞﾘなら出来そうですが）

この「ｻﾌﾞﾂﾘｰ」ｺﾏﾝﾄﾞの存在に気が付いたのは、「表示」-「ｺﾏﾝﾄﾞﾘｽﾄ」です。

恐らくﾗｲｾﾝｽに関係無く、ｱｸﾃｨﾌﾞなﾜｰｸﾍﾞﾝﾁで利用可能なｺﾏﾝﾄﾞのﾘｽﾄを
表示してくれます。
ここで表示されるものであれば StartCommand で利用可能だと思います。

StartCommand は起動している言語に依存していますが、こちらに記載した
コマンドIDを利用すれば、言語依存しないﾏｸﾛが作れます。
コマンドID - C#ATIA

但し、今回の「ｻﾌﾞﾂﾘｰ」ｺﾏﾝﾄﾞについては、GrabCADにUpしたﾘｽﾄには
入ってませんでした･･･。

子ｳｨﾝﾄﾞｳの整列ｽﾀｲﾙ

御質問頂いた際、正直何のことかわかりませんでした。
が、調べたら理解できました。（最初はﾊﾟﾀｰﾝの何か? かと思いました）

要は、ここの表示の切り替えをﾏｸﾛで行いたいと言う事ですよね？

'CatArrangeStyleﾃｽﾄ
Sub CATMain()

    Call CATIA.Windows.Arrange(CatArrangeStyle.catArrangeCascade)
    CATIA.RefreshDisplay = True
    MsgBox "CatArrangeStyle - catArrangeCascade"
    
    Call CATIA.Windows.Arrange(CatArrangeStyle.catArrangeTiledHorizontal)
    CATIA.RefreshDisplay = True
    MsgBox "CatArrangeStyle - catArrangeTiledHorizontal"
        
    Call CATIA.Windows.Arrange(CatArrangeStyle.catArrangeTiledVertical)
    CATIA.RefreshDisplay = True
    MsgBox "CatArrangeStyle - catArrangeTiledVertical"

End Sub

3つのｽﾀｲﾙを順番に変更します。最小化しているｳｨﾝﾄﾞｳは影響無いようです。
又、環境や使用方法次第ですが、RefreshDisplayを入れておかないと
ｽﾀｲﾙの変更が間に合わない場合があるかもしれません。
（こちらで試した際、入れないと半分ぐらいしか表示しない状態で
　　MsgBoxが出現しました）

ﾃﾞｰﾀﾑ化された要素の入っている形状ｾｯﾄの取得

”ﾏｸﾛがPCによって動くものと動かないものがある”と相談を頂きました。
状況が良くわからないので、完全な答えには辿り着けない可能性も有りますが。。。

点を選択後、点の含まれている形状ｾｯﾄの取得部分が問題のようです。

まず、こんなﾃﾞｰﾀを用意しました。

点1は通常の状態で、点2はﾃﾞｰﾀﾑ化されています。

続いてこんなﾏｸﾛを作りました。

'catvba
Sub CATMain()
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As Variant ' Selection
    Set sel = doc.Selection
    
    '選択
    Dim msg As String
    msg = "点を選択"
    
    Dim filter As Variant
    filter = Array("Point")
    
    sel.Clear
    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Sub
    End Select
    
    '選択要素の取得
    Dim point As AnyObject
    Set point = sel.Item(1).value
    
    '結果
    Debug.Print "********"
    Debug.Print "point typename : ", TypeName(point)
    Debug.Print "point.Parent typename : ", TypeName(point.Parent)
    Debug.Print "point.Parent.Parent typename : ", TypeName(point.Parent.Parent)
    Debug.Print "point.Thickness.Parent.Parent typename : ", TypeName(point.Thickness.Parent.Parent)
End Sub

点を選択し、Parentのｵﾌﾞｼﾞｪｸﾄﾀｲﾌﾟをｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示します。
もう答えは書いているのですが・・・。

GSD要素がﾃﾞｰﾀﾑ化されている場合とされていない場合では、画面上や手動操作では
大きな違いを感じませんが、ﾏｸﾛではかなりの違いが有ります。

このﾏｸﾛで点1を選択した際の結果はこちら

********
point typename :            HybridShapePointOnPlane
point.Parent typename :     HybridShapes
point.Parent.Parent typename :            HybridBody
point.Thickness.Parent.Parent typename :  HybridBody

質問者さんのｺｰﾄﾞでは、"point.Parent.Parent" となっており、HybridBodyが
取得できています。

続いて点2を選択した際の結果はこちら

********
point typename :            HybridShapePointExplicit
point.Parent typename :     Parameters
point.Parent.Parent typename :            Part
point.Thickness.Parent.Parent typename :  HybridBody

"point.Parent.Parent" は、HybridBodyではなくPartになります。
そもそも point.Parent が、点1では HybridShapes なのに対し
点2では Parameters になります。

ﾃﾞｰﾀﾑ化されている・されていないを判断し処理を分けるのも
良いかもしれませんが、共通のﾌﾟﾛﾊﾟﾃｨ Thickness を利用すると
処理を分ける必要も無さそうです。

    Dim HybrBody As HybridBody
    Set HybrBody = point.Thickness.Parent.Parent

Thicknessﾌﾟﾛﾊﾟﾃｨ は　HybridShapeｵﾌﾞｼﾞｪｸﾄで実装されています。
以前から思うのですが、何故GSD要素に "厚み" が必要なのかな？
(ﾗｲｾﾝｽ無いのでわからないのですが ﾎﾞﾘｭｰﾑ?)

ﾌｧｲﾙを最小化でｵｰﾌﾟﾝしつつ、ｵｰﾌﾟﾝ前のｳｨﾝﾄﾞｳをｱｸﾃｨﾌﾞ化

「ﾊﾟﾜｰｺﾋﾟｰのPartﾌｧｲﾙを最小化で開きつつ、開く前のｱｸﾃｨﾌﾞな'ｳｨﾝﾄﾞｳをｱｸﾃｨﾌﾞ状態にする」
と言う内容のご相談を頂きました。

正直な所、どのような操作を想定されているのかが、把握できていない為
目的の状態になっていない可能性もありますが･･･

'vba
Sub CATMain()
    'ﾊﾟﾜｰｺﾋﾟｰﾌｧｲﾙ ﾊﾟｽ
    Dim PowerCopy_path As String
    PowerCopy_path = "C:\temp\powercopy_part.CATPart"
    
    'ﾊﾟﾜｰｺﾋﾟｰﾌｧｲﾙ ｵｰﾌﾟﾝ前に現在のｱｸﾃｨﾌﾞな
    'ｳｨﾝﾄﾞｳを取得
    Dim BeforeActWin As Window
    Set BeforeActWin = CATIA.ActiveWindow
    
    'ﾊﾟﾜｰｺﾋﾟｰﾌｧｲﾙ ｵｰﾌﾟﾝ
    Dim objPspDoc As PartDocument
    Set objPspDoc = CATIA.Documents.Open(PowerCopy_path)
    
    'ﾊﾟﾜｰｺﾋﾟｰﾌｧｲﾙ のｳｨﾝﾄﾞｳ
    Dim ActiveWin As Window
    'Set ActiveWin = CATIA.ActiveWindow
    Set ActiveWin = CATIA.Windows.Item(CATIA.Windows.count)
    
    '最小化
    ActiveWin.WindowState = catWindowStateMinimized
    
    '最初のｱｸﾃｨﾌﾞなｳｨﾝﾄﾞｳをｱｸﾃｨﾌﾞ
    BeforeActWin.Activate
    
    'ここで何かしらの処理
    Stop
    
    'ﾊﾟﾜｰｺﾋﾟｰﾌｧｲﾙ ｸﾛｰｽﾞ
    objPspDoc.Close
End Sub

・ﾌｧｲﾙをｵｰﾌﾟﾝする前に、現状のｱｸﾃｨﾌﾞｳｨﾝﾄﾞｳを取得しておきます。
　　（Set BeforeActWin = CATIA.ActiveWindow）
・ｳｨﾝﾄﾞｳの最小化はWindowStateﾌﾟﾛﾊﾟﾃｨで可能です。
　　（ActiveWin.WindowState = catWindowStateMinimized）