配置ｽｹｯﾁを判断する

結論として、配置ｽｹｯﾁ(positioned sketch)はマクロでは
パワーコピー以外では作れないと思っています。

それに取り組んでいた際、気が付いた事がｽｹｯﾁのﾀｲﾌﾟの判断方法です。
f:id:kandennti:20191007141737p:plain
いつか書こうと思っていたのですが、良い機会なので記載しておきます。

SketchオブジェクトのGetAbsoluteAxisDataメソッドを利用すると
ｽｹｯﾁｻﾎﾟｰﾄ平面の数値的な情報が得られます。
r1 Sketch (Object)

又、SetAbsoluteAxisDataメソッドを利用するとｽｹｯﾁｻﾎﾟｰﾄ平面を数値的な
意味で変更可能です。但し、配置ｽｹｯﾁに関しては変更出来ません。
が、逆にとらえると配置ｽｹｯﾁであることは判断可能です。

'vba 配置ｽｹｯﾁの判断

Option Explicit

Sub CATMain()

    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As selection
    Set sel = doc.selection
    
    Dim pt As part
    Set pt = doc.part
    
    '全ｽｹｯﾁ取得
    Dim skts As Collection
    Set skts = New Collection
    
    sel.Clear
    sel.Search "CATPrtSearch.Sketch,all"
    Dim i As Long
    For i = 1 To sel.Count2
        skts.Add sel.Item2(i).Value
    Next
    sel.Clear
    
    '一時作業用形状セット
    Dim hbdy As HybridBody
    Set hbdy = doc.part.HybridBodies.Add()
    
    'ｽｹｯﾁﾀｲﾌﾟ判断
    Dim msg As String
    
    CATIA.HSOSynchronized = False
    
    Dim skt As Sketch
    Dim skt_tmp As Sketch
    For Each skt In skts
        'ｺﾋﾟﾍﾟ
        With sel
            .Clear
            .Add skt
            .Copy
            .Clear
            .Add hbdy
            .Paste
            Set skt_tmp = .Item2(1).Value
            .Copy
        End With
        
        msg = msg & skt.Name & " : "
        If IsPositioned(skt_tmp, sel) Then
            msg = msg & "Positioned" & vbCrLf
        Else
            msg = msg & "Sliding or Isolated" & vbCrLf
        End If
    Next
    
    '一時要素削除
    sel.Add hbdy
    sel.Delete
    pt.Update
    
    CATIA.HSOSynchronized = True
    
    MsgBox msg
    
End Sub

Private Function IsPositioned( _
    ByVal skt As Variant, _
    ByVal sel As selection _
    ) As Boolean
    
    sel.Clear
    sel.Add skt
    
    '変更前ｽｹｯﾁｻﾎﾟｰﾄ情報
    Dim ax(8) As Variant
    skt.GetAbsoluteAxisData ax
    
    '変更前原点x
    Dim x As Double
    x = ax(0)
    
    '変更 x+1
    ax(0) = ax(0) + 1
    skt.SetAbsoluteAxisData ax
    
    '変更後ｽｹｯﾁｻﾎﾟｰﾄ情報
    skt.GetAbsoluteAxisData ax
    
    '移動しているか?で判断
    IsPositioned = IIf(x = ax(0), True, False)
    
End Function