C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA(最近はPMillマクロとFusion360APIが多い)

spy++

以前は、古いVSじゃないと入手出来ないような雰囲気だったので
類似品が結構出ていたような気もしたのですが、spy++は今でもちゃんと
入手できる事を知りませんでした。
Spy++ が見つからないときの対処方法 - xin9le.net


VBA用のWinAPIは、Web上では結構新旧混在している状態で
物凄くわかりにくいです。探した所64bitで利用出来るように
なった状態でゴッソリここに記載されていました。
http://www.cadsharp.com/docs/Win32API_PtrSafe.txt
全てでは無さそうですが、恐らく困ることが無いレベルだと
思います。
SolidWorksのマクロなサイトのようで、大量にマクロが公開されています。
https://www.cadsharp.com/

寸法をクリックし、2Dコンポーネントを配置する

こちらの続きです。
寸法をクリックして直交する線を書く - C#ATIA

・・・▽▽対策のマクロです。

'vba Finish_Mark_ver0.0.1  using-'KCL0.0.12'  by Kantoku

Option Explicit

'インスタンス作成用情報
Private Type CompBase
    view As DrawingView
    scale2 As Double
End Type

'参照寸法用
Private Type TargetDim
    dim As DrawingDimension
    pos As Variant
End Type

Private Const EPS = 0.0001          'イコール判断


Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'インスタンスベースの選択
    Dim cmp_base As CompBase
    cmp_base = SelectComp()
    If cmp_base.view Is Nothing Then Exit Sub
    
    'モロモロ
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = doc.Selection
    
    '配置ループ
    Dim msg As String
    
    Do
        Dim dim_info As TargetDim
        '参照する寸法選択
        dim_info = SelectDimension(sel)
        If dim_info.dim Is Nothing Then Exit Sub
        
        'アクティブビュー
        Dim ac As DrawingView
        Set ac = doc.Sheets.ActiveSheet.Views.ActiveView
        
        'ターゲットビュー
        Dim tg As DrawingView
        Set tg = KCL.GetParent_Of_T(dim_info.dim, "DrawingView")
    
        'ビュー間ベクトル
        Dim tran_vec As Variant
        tran_vec = GetTransVec(ac, tg)
        
        '該当するビューの座標に変換
        dim_info.pos = Add2d(tran_vec, dim_info.pos)
    
        '寸法線/補助線情報
        Dim dim_geo As Variant
        dim_geo = GetDimGeoInfo(dim_info.dim)
        
        '一番近い寸法線/補助線上の座標値を取得
        Dim cmp_pos As Variant
        cmp_pos = GetMinPos(dim_geo, dim_info.pos)
        
        'インスタンス作成
        Dim cmp As DrawingComponent
        Set cmp = tg.Components.Add(cmp_base.view, cmp_pos(0)(0), cmp_pos(0)(1))
        cmp.angle = GetAng(cmp_pos(1), cmp_pos(2), dim_info.pos)
        cmp.scale2 = cmp_base.scale2
        
        'doc.Update
        '確認
        '検索の表示で画面内に入っているかをチェックする?
        
        msg = "宜しいですか?" & vbCrLf & _
            "(はい-配置 , いいえ-反転して配置 , キャンセル-配置を中止)"
        Dim btm_Opt As Long
        btm_Opt = vbYesNoCancel + vbInformation
        
        Select Case MsgBox(msg, vbYesNoCancel)
            Case vbYes
                'そのまま
            Case vbNo
                cmp.angle = cmp.angle - PI '2*PI超えるとエラーかも
            Case vbCancel
                sel.Clear
                sel.Add cmp
                sel.Delete
        End Select
        sel.Clear
    Loop
End Sub


'ディテールシートのビューか?
Private Function IsDetailSheetView(ByVal v As DrawingView) As Boolean
    Dim dmy As Variant
    
    On Error Resume Next
    err.Clear
    Set dmy = v.GenerativeLinks
    
    If err.Number = 0 Then
        IsDetailSheetView = False
    Else
        IsDetailSheetView = True
    End If
    
    err.Clear
    On Error GoTo 0
End Function

'インスタンスベースの選択
Private Function SelectComp() As CompBase
    Dim msg$
    msg = "2Dコンポーネント 又は ディテールビューを選択 : ESCキー 終了"
    
    Dim Itm As AnyObject
    Set Itm = KCL.SelectItem(msg, "DrawingComponent,DrawingView")
    If Itm Is Nothing Then Exit Function
        
    Dim cb As CompBase
    
    If TypeName(Itm) = "DrawingComponent" Then
        Set cb.view = Itm.CompRef
        cb.scale2 = Itm.scale2
        SelectComp = cb
        Exit Function
    End If
    
    If IsDetailSheetView(Itm) Then
        Set cb.view = Itm
        cb.scale2 = Itm.scale2 '1#
        SelectComp = cb
        Exit Function
    End If
    
    MsgBox "選択可能なビューは、ディテールのもののみです"
End Function

'配置基準となる寸法選択
Private Function SelectDimension(ByVal sel As Variant) As TargetDim
    Dim msg As String
    msg = "寸法線をクリックして下さい"
    
    Dim filter As Variant
    filter = Array("DrawingDimension")
    
'ObjectSelectionBeforeCommandUsePossibility
'iTooltip
'iTriggeringOnMouseMove
'のどれかは直接IndicateOrSelectElement2Dに書いたほうが良い見たい
    
    'Select状態
    Dim ojSelected As Variant 'Boolean
    
    '値はアクティブビュー上での座標値
    Dim winLocat(1) As Variant 'Double
    
    'マウスの状態
    Dim status As String
    status = "MouseMove"

    Dim tgt As TargetDim
    Do
        status = sel.IndicateOrSelectElement2D( _
            msg, _
            filter, _
            False, _
            False, _
            True, _
            ojSelected, _
            winLocat)
        
        If status = "Normal" And sel.Count2 > 0 Then
            Exit Do
        End If
        
        If status = "Cancel" Then
            Exit Function
        End If
    Loop
    Set tgt.dim = sel.Item(1).Value
    tgt.pos = winLocat
    
    SelectDimension = tgt
End Function

'コンポーネント配置角度算出
'param:s_pos-寸法線スタート位置 e_pos-寸法線エンド位置 ref_pos-クリック位置
'return:角度単位rad
Private Function GetAng( _
    ByVal s_pos As Variant, _
    ByVal e_pos As Variant, _
    ByVal ref_pos As Variant) As Double
    
    '寸法線に対してのクリック向きの算出
    Dim dim_vec As Variant
    dim_vec = Sub2d(s_pos, e_pos)
    
    Dim ref_vec As Variant
    ref_vec = Sub2d(s_pos, ref_pos)
    
    Dim crs_vec As Variant
    crs_vec = Cross2d(dim_vec, ref_vec)
    
    '寸法線角度
    Dim dim_rad As Double
    dim_rad = Atn2(dim_vec(1), dim_vec(0))
    
    GetAng = dim_rad
    If Sgn(crs_vec) > 0 Then
        GetAng = GetAng + PI
    End If
End Function

'複数線上と指定座標の最も近い位置の座標値取得
'0-線上xy 1-線始点xy 2-線終点xy
Private Function GetMinPos( _
    ByVal geos As Variant, _
    ByVal pos As Variant) As Variant
    
    Dim min As Double
    min = 1000000000
    
    Dim min_lin As Variant
    Dim tmp As Double
    Dim i As Long
    For i = 0 To UBound(geos)
        tmp = Dist_AB_C(geos(i)(0), geos(i)(1), pos)
        If tmp < min Then
            min = tmp
            min_lin = Array(geos(i)(0), geos(i)(1))
        End If
    Next
    
    '線上の最短点
    Dim min_nml As Variant
    min_nml = Normaliz2d(min_lin(0), min_lin(1))
    
    Dim lng As Double
    lng = Dot2d(min_nml, Sub2d(pos, min_lin(0)))
    
    Dim xy As Variant
    xy = Add2d(min_lin(0), Array(min_nml(0) * lng, min_nml(1) * lng))
    
    GetMinPos = Array(xy, min_lin(0), min_lin(1))
End Function

'ビュー間ベクトル
Private Function GetTransVec( _
    ByVal act_v As DrawingView, _
    ByVal tgt_v As DrawingView) As Variant
    
    GetTransVec = Sub2d( _
        Array(act_v.xAxisData, act_v.yAxisData), _
        Array(tgt_v.xAxisData, tgt_v.yAxisData))
End Function

'寸法線、補助線座標値取得 0-寸,1-補1,2-補2
Private Function GetDimGeoInfo( _
    ByVal drwDim As DrawingDimension) As Variant
    
    Dim dl As Variant 'DrawingDimLine or DrawingDimExtLine
    Dim dimgeo(3) As Variant
    
    Set dl = drwDim.GetDimLine
    Call dl.GetGeomInfo(dimgeo)
    
    Dim ex1geo(3) As Variant
    Set dl = drwDim.GetDimExtLine
    Call dl.GetGeomInfo(1, ex1geo)
    
    Dim ex2geo(3) As Variant
    Call dl.GetGeomInfo(2, ex2geo)
    
    GetDimGeoInfo = Array( _
        Array(Array(dimgeo(0), dimgeo(1)), Array(dimgeo(2), dimgeo(3))), _
        Array(Array(dimgeo(0), dimgeo(1)), Array(ex1geo(0), ex1geo(1))), _
        Array(Array(dimgeo(2), dimgeo(3)), Array(ex2geo(0), ex2geo(1))) _
        )
End Function


'*** Math ***
Private Function PI() As Double
    PI = Atn(1) * 4
End Function

'ArcCos
Private Function ArcCos(ByVal v As Double) As Double
    ArcCos = Atn(-v / Sqr(-v * v + 1)) + 2 * Atn(1)
End Function

'Atn2
Private Function Atn2(ByVal y As Double, ByVal x As Double) As Double
    Select Case x
        Case Is > 0
            Atn2 = Atn(y / x)
        Case Is < 0
            Atn2 = Atn(y / x) + PI * Sgn(y)
            If y = 0 Then Atn2 = Atn2 + PI
        Case Is = 0
            Atn2 = (PI * 0.5) * Sgn(y)
    End Select
End Function

'2点距離の平方数
Private Function LengSqr(ByVal p1 As Variant, ByVal p2 As Variant) As Double
    Dim A#: A = p2(0) - p1(0)
    Dim B#: B = p2(1) - p1(1)
    LengSqr = A * A + B * B
End Function

'イコール
Private Function EQ(ByVal A As Double, ByVal B As Double) As Boolean
    EQ = IIf(Abs((A) - (B)) < EPS, True, False)
End Function


'vecter
'点A,Bを通過する無限直線と点Cとの距離
Private Function Dist_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    Dist_AB_C = Lng_AB_C(A, B, C)
End Function

'ベクトルABと点Cの距離
Private Function Lng_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    Lng_AB_C = Abs(Cross2d(Sub2d(B, A), Sub2d(C, A))) / Abs(Sqr(LengSqr(B, A)))
End Function

'単位ベクトルVと点Pの距離
Private Function Lng_V_P(ByVal v As Variant, ByVal p As Variant) As Double
    Lng_V_P = Abs(Cross2d(v, p))
End Function

'単位ベクトル
Private Function Normaliz2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Dim vec: vec = Sub2d(V2, V1)
    Dim tmp: tmp = Sqr(Dot2d(vec, vec))
    If EQ(tmp, 0#) Then
        Normaliz2d = Empty
        Exit Function
    End If
    Normaliz2d = Array(vec(0) / tmp, vec(1) / tmp)
End Function

'和2D
Private Function Add2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Add2d = Array(V1(0) + V2(0), V1(1) + V2(1))
End Function

'差2D
Private Function Sub2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Sub2d = Array(V1(0) - V2(0), V1(1) - V2(1))
End Function

'内積2D
Private Function Dot2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Dot2d = V1(0) * V2(0) + V1(1) * V2(1)
End Function

'外積2D
Private Function Cross2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Cross2d = V1(0) * V2(1) - V1(1) * V2(0)
End Function

・元のビューはこんな原点位置で考慮しており、角度もこれが0度としています。
f:id:kandennti:20181109104441p:plain

・マクロ実行後、2Dコンポーネントかディテールシートのビューを選択し、その後寸法線・寸法補助線を
クリックすることで、2Dコンポーネントをそれなりの角度・位置で配置します。
但し、意図しない場合が多いため、一旦仮の配置を行ったのちこのようなダイアログが
出る為、必要に応じて反転させてください。(y4yamaさんのもこんな感じでした、確か)
f:id:kandennti:20181109104424p:plain

・配置する際のスケールは元のスケールを保持します。

・通常、2Dコンポーネントはアクティブなビューに配置されますが、クリックした際の寸法が
存在しているビューに配置します。こちらの "残念、そこじゃないんだよね" 対策。
寸法をクリックして直交する線を書く - C#ATIA

・マクロ的に寸法線、寸法補助線はこちらの赤印部分の座標値しか取得できません。
f:id:kandennti:20181109104449p:plain
この四点から緑色の線を想定し、クリック位置に一番近い線を選び出し線上の座標値を
算出する仕組みになっています。クリック座標の精度の悪さとの相乗効果で、矢印付近を
クリックした際、思惑とは90度異なったものが表示される可能性が有ります。

・上記の理由から角度寸法線のような曲線に対しては、正しく配置出来ません。
f:id:kandennti:20181109104458p:plain
角度寸法だと判断し、すれなりに計算すれば対応できるのですが、頑張れません。
あまりする必要性も無いとは思ってます。

・累進寸法でファンネルを利用している場合、正しい位置には配置出来ません。
f:id:kandennti:20181109104507p:plain
こちらに記載した、GetFunnelメソッドがエラーなる為、値の取得が出来ないからです。
ファンネル - C#ATIA

・このマクロが一年以内の出来るだけ早い段階で不要になることを、熱望しています。

寸法をクリックして直交する線を書く

こちらの続きです。
http://kantoku.hatenablog.com/entry/2018/10/23/181308

こんな感じのDrawです。
f:id:kandennti:20181106162225p:plain
正面図がアクティブな状態で、右側面図の寸法位置に▽▽の2Dコンポーネント
配置しようとすると
f:id:kandennti:20181106162255p:plain
正面図が大きくなりますし、当然レイアウトを変更したら根拠の全く無いマークが
残ります。標準の仕上記号であれば、同様の操作を行っても、きちっと
右側面図に入ってくれます。
f:id:kandennti:20181106162305p:plain
寸法を移動しても仕上記号が付いてきてくれるので、もう一つ悩まされている
ファンネルにも対応できます。
(▽▽で行っていると手間が3~5倍ぐらいかかっている気がしてます)


まだ作りかけですが、寸法をクリックした位置に対して直交する線を描く
だけのテストマクロです。

'vba 寸法線クリックテスト  using-'KCL0.0.12'

Sub CATMain()
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As Variant ' Selection
    Set sel = doc.Selection
    
    '座標選択
    Dim status As String
    status = "MouseMove"
    Dim ObjectSelected
    Dim WindowLocation(1)
    Dim filter As Variant
    filter = Array("DrawingDimension")
    
    'WindowLocationの座標値はアクティブビューに対しての座標値
    Dim pos As Variant
    Do While (status = "MouseMove")
        status = sel.IndicateOrSelectElement2D( _
            "select", _
            filter, _
            False, _
            False, _
            True, _
            ObjectSelected, _
            WindowLocation)
        If Not ObjectSelected Then
            pos = WindowLocation
        End If
    Loop
    
    '選択寸法
    Dim drwDim As DrawingDimension
    Set drwDim = sel.Item(1).value
    
    'アクティブビュー
    Dim ac As DrawingView
    Set ac = doc.Sheets.ActiveSheet.Views.ActiveView
    
    'ターゲットビュー
    Dim tg As DrawingView
    Set tg = KCL.GetParent_Of_T(drwDim, "DrawingView")
    
    'ビュー間ベクトル
    Dim tran_vec As Variant
    tran_vec = GetTransVec(ac, tg)
    
    '該当するビューの座標に変換
    pos = Add2d(tran_vec, pos)
    
    '寸法線/補助線情報
    Dim dim_geo As Variant
    dim_geo = GetDimGeoInfo(drwDim)
    
    '一番近い寸法線/補助線上の座標値を取得
    Dim pp As Variant
    pp = GetMinPos(dim_geo, pos)
    
    '線作成
    Call InitLine2D(tg, pp, pos)
    
    doc.Update
End Sub

'複数線上と指定座標の最も近い位置の座標値取得
Private Function GetMinPos( _
    ByVal geos As Variant, _
    ByVal pos As Variant) As Variant
    
    Dim min As Double
    min = 1000000000
    
    Dim min_lin As Variant
    Dim tmp As Double
    Dim i As Long
    For i = 0 To UBound(geos)
        tmp = Dist_AB_C(geos(i)(0), geos(i)(1), pos)
        If tmp < min Then
            min = tmp
            min_lin = Array(geos(i)(0), geos(i)(1))
        End If
    Next
    
    Dim min_nml As Variant
    min_nml = Normaliz2d(min_lin(0), min_lin(1))
    
    Dim vec As Variant
    vec = Sub2d(pos, min_lin(0))
    
    Dim lng As Double
    lng = Dot2d(min_nml, vec)
    
    GetMinPos = Add2d(min_lin(0), Array(min_nml(0) * lng, min_nml(1) * lng))
End Function

'ビュー間ベクトル
Private Function GetTransVec( _
    ByVal act_v As DrawingView, _
    ByVal tgt_v As DrawingView) As Variant
    
    GetTransVec = Sub2d( _
        Array(act_v.xAxisData, act_v.yAxisData), _
        Array(tgt_v.xAxisData, tgt_v.yAxisData))
End Function

'寸法線、補助線座標値取得 0-寸,1-補1,2-補2
Private Function GetDimGeoInfo( _
    ByVal drwDim As DrawingDimension) As Variant
    
    Dim dl As Variant 'DrawingDimLine or DrawingDimExtLine
    Dim dimgeo(3) As Variant
    
    Set dl = drwDim.GetDimLine
    Call dl.GetGeomInfo(dimgeo)
    
    Dim ex1geo(3) As Variant
    Set dl = drwDim.GetDimExtLine
    Call dl.GetGeomInfo(1, ex1geo)
    
    Dim ex2geo(3) As Variant
    Call dl.GetGeomInfo(2, ex2geo)
    
    GetDimGeoInfo = Array( _
        Array(Array(dimgeo(0), dimgeo(1)), Array(dimgeo(2), dimgeo(3))), _
        Array(Array(dimgeo(0), dimgeo(1)), Array(ex1geo(0), ex1geo(1))), _
        Array(Array(dimgeo(2), dimgeo(3)), Array(ex2geo(0), ex2geo(1))) _
        )
End Function

'要素はビューをアクティブにして作成する必要有り
'点の作成
Private Function InitPnt2D( _
    ByVal tgt_v As DrawingView, _
    ByVal pos As Variant, _
    Optional ByVal act_v As DrawingView = Nothing) As Point2D
    
    If act_v Is Nothing Then
        Set act_v = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView
    End If
    
    tgt_v.Activate
    
    Dim fact As Factory2D
    Set fact = tgt_v.Factory2D
    
    Set InitPnt2D = fact.CreatePoint(pos(0), pos(1))
    
    act_v.Activate
End Function

'線の作成
Private Function InitLine2D( _
    ByVal tgt_v As DrawingView, _
    ByVal p1 As Variant, _
    ByVal p2 As Variant, _
    Optional ByVal act_v As DrawingView = Nothing) As Line2D
    
    If act_v Is Nothing Then
        Set act_v = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView
    End If
    
    tgt_v.Activate
    
    Dim fact As Factory2D
    Set fact = tgt_v.Factory2D
    
    Set InitLine2D = fact.CreateLine(p1(0), p1(1), p2(0), p2(1))
    
    act_v.Activate
End Function


'*** Math ***
'ArcCos
Private Function ArcCos(ByVal V As Double) As Double
    ArcCos = Atn(-V / Sqr(-V * V + 1)) + 2 * Atn(1)
End Function

'2点距離の平方数
Private Function LengSqr(ByVal p1 As Variant, ByVal p2 As Variant) As Double
    Dim A#: A = p2(0) - p1(0)
    Dim B#: B = p2(1) - p1(1)
    LengSqr = A * A + B * B
End Function

'イコール
Private Function EQ(ByVal A As Double, ByVal B As Double) As Boolean
    EQ = IIf(Abs((A) - (B)) < EPS, True, False)
End Function


'vecter
'点A,Bを端点とする線分と点Cとの距離
Private Function Dist_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    If Dot2d(Sub2d(B, A), Sub2d(C, A)) < EPS Then
        Dist_AB_C = Abs(Sqr(LengSqr(C, A)))
        Exit Function
    End If
    If Dot2d(Sub2d(A, B), Sub2d(C, B)) < EPS Then
        Dist_AB_C = Abs(Sqr(LengSqr(C, B)))
        Exit Function
    End If
    Dist_AB_C = Lng_AB_C(A, B, C)
End Function

'ベクトルABと点Cの距離
Private Function Lng_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    Lng_AB_C = Abs(Cross2d(Sub2d(B, A), Sub2d(C, A))) / Abs(Sqr(LengSqr(B, A)))
End Function

'単位ベクトルVと点Pの距離
Private Function Lng_V_P(ByVal V As Variant, ByVal P As Variant) As Double
    Lng_V_P = Abs(Cross2d(V, P))
End Function

'単位ベクトル
Private Function Normaliz2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Dim vec: vec = Sub2d(V2, V1)
    Dim tmp: tmp = Sqr(Dot2d(vec, vec))
    If EQ(tmp, 0#) Then
        Normaliz2d = Empty
        Exit Function
    End If
    Normaliz2d = Array(vec(0) / tmp, vec(1) / tmp)
End Function

'和2D
Private Function Add2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Add2d = Array(V1(0) + V2(0), V1(1) + V2(1))
End Function

'差2D
Private Function Sub2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Sub2d = Array(V1(0) - V2(0), V1(1) - V2(1))
End Function

'内積2D
Private Function Dot2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Dot2d = V1(0) * V2(0) + V1(1) * V2(1)
End Function

'外積2D
Private Function Cross2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Cross2d = V1(0) * V2(1) - V1(1) * V2(0)
End Function

他のマクロからコピペした関数だらけなので、使っていないものが多数入ってます。
IndicateOrSelectElement2Dのクリックした座標値の精度悪いですね。3Dも悪かったような。
f:id:kandennti:20181106162319p:plain
モチベーションが低すぎて、完成するかわからない・・・。

ビューの位置を保存・再現2

こちらの続きです。
ビューの位置を保存・再現 - C#ATIA

前回不満だった
・マクロ処理後の移動ログ表示ミス
・角度の再現化
を修正しました。

'vba Draw_ViewsPositionLoaderWriter ver0.0.3  using-'KCL0.0.12'  by Kantoku
'
'ver0.0.1:完成
'ver0.0.2:読み書き1本化,未変更時Writer書き込まない
'ver0.0.3:ログを正しく表記するよう修正,角度も再現化

Option Explicit

'変更しないで!
Private Const VIEWS_POS_HAEDER = "views_pos_"

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'モロモロ
    Dim msg As String
    
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sheet As DrawingSheet
    Set sheet = doc.Sheets.ActiveSheet
    
    'View数チェック
    Dim vs As DrawingViews
    Set vs = sheet.Views
    
    If vs.Count < 3 Then
        msg = "処理を行うViewがありません!"
        MsgBox msg, vbOKOnly + vbExclamation
        Exit Sub
    End If

    'パラメーターチェック
    Dim prm_name As String
    prm_name = VIEWS_POS_HAEDER & sheet.Name
    
    Dim prm As StrParam
    Set prm = GetParam(prm_name)
    
    '選択/処理
    msg = "View位置の保存・再現を行います" & vbCrLf & _
          "再 現 : はい" & vbCrLf & _
          "保 存 : いいえ" & vbCrLf & _
          "中 止 : キャンセル"
    
    If prm Is Nothing Then
        msg = msg & vbCrLf & _
              "※保存データが無いため再現できません!!"
    End If
    
    Select Case MsgBox(msg, vbYesNoCancel)
        Case vbYes
            Call ViewsPositionLoader(prm, vs)
        Case vbNo
            Call ViewsPositionWriter(prm, prm_name, vs)
    End Select
End Sub

' -- Loader --
Private Sub ViewsPositionLoader(ByVal prm As StrParam, _
                                ByVal vs As DrawingViews)
    Dim msg As String
    
    If prm Is Nothing Then
        msg = "保存されたView位置がありませんでした"
        MsgBox msg, vbOKOnly + vbInformation
        Exit Sub
    End If
    
    '読み出しのビュー情報取得
    Dim load_infos As Object
    Set load_infos = LoadInfos_Dic(prm.Value)
    
    '現状のビュー情報取得
    Dim unreg As String
    unreg = GetUnregisteredViews(vs, load_infos)
    
    '確認
    msg = "View位置を再現しますか?"
    If Not unreg = vbNullString Then
        msg = "以下のViewの位置が記録されていませんでした" & vbCrLf & _
              unreg & msg
    End If
    
    If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If
    
    '実行
    msg = ExecMoveViews(vs, load_infos)
    
    MsgBox "Done" & vbCrLf & msg
End Sub

Private Function ExecMoveViews(ByVal vs As DrawingViews, _
                               ByVal dic As Object) As String

    '実行前位置
    Dim before_pos As Variant
    before_pos = GetViewsInfo(vs)
    
    '移動実行
    Dim key As Variant ' String
    Dim v As DrawingView
    Dim xy As Variant
    
    For Each key In dic
        Set v = GetView(vs, key)
        If v Is Nothing Then GoTo continue
        
        xy = dic(key)
        If Not KCL.IsAryEqual( _
                Array(CStr(v.xAxisData), CStr(v.yAxisData), CStr(v.angle)), _
                xy) Then
            v.xAxisData = CDbl(xy(0))
            v.yAxisData = CDbl(xy(1))
            v.angle = CDbl(xy(2))
        End If
continue:
    Next
    
    '結果
    Dim msg As String
    Dim info As Variant
    Dim i As Long
    
    For i = 0 To UBound(before_pos)
        info = Split(before_pos(i), ",")
        
        Set v = GetView(vs, info(0))
        msg = msg & v.Name & " : 移動"
        
        If Not dic.Exists(info(0)) Then
            msg = msg & "していません" & vbCrLf
            GoTo continue_res
        End If
        
        xy = dic(info(0))
        If Not KCL.IsAryEqual(Array(CStr(info(1)), CStr(info(2)), CStr(info(3))), xy) Then
            msg = msg & "しました!" & vbCrLf
        Else
            msg = msg & "していません" & vbCrLf
        End If
continue_res:
    Next
    
    ExecMoveViews = msg
End Function

Private Function GetView(ByVal vs As DrawingViews, _
                         ByVal s As String) As DrawingView
    On Error Resume Next
        Set GetView = vs.GetItem(s)
    On Error GoTo 0
End Function

Private Function GetUnregisteredViews(ByVal vs As DrawingViews, _
                                      ByVal dic As Object) As String
    Dim msg As String
    
    Dim i As Long
    Dim v As DrawingView
    
    For i = 0 To vs.Count - 3
        Set v = vs.Item(i + 3)
        If Not dic.Exists(KCL.GetInternalName(v)) Then
            msg = msg & v.Name & vbCrLf
        End If
    Next
    
    GetUnregisteredViews = msg
End Function

Private Function LoadInfos_Dic(ByVal data As String) As Object
    Dim dic As Object
    Set dic = KCL.InitDic()
    
    Dim infos As Variant
    infos = Split(data, "@")
    
    Dim i As Long
    Dim info_ary As Variant
    For i = 0 To UBound(infos)
        info_ary = Split(infos(i), ",")
        If UBound(info_ary) < 4 Then
            dic.Add info_ary(0), Array(info_ary(1), info_ary(2), "0")
        Else
            dic.Add info_ary(0), Array(info_ary(1), info_ary(2), info_ary(3))
        End If
    Next
    
    Set LoadInfos_Dic = dic
End Function

' -- Writer --
Private Sub ViewsPositionWriter(ByVal prm As StrParam, _
                                ByVal prm_name As String, _
                                ByVal vs As DrawingViews)
    Dim msg As String
    
    If prm Is Nothing Then
        Set prm = InitParam(prm_name)
    Else
        msg = "過去にView位置を保存しています" & vbCrLf & _
              "上書きしますか?"
        If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        End If
    End If
    
    'ビュー情報取得
    Dim infos As String
    infos = CStr(Join(GetViewsInfo(vs), "@"))
    
    'パラメータ書き込み
    prm.Value = infos
    
    MsgBox "Done"
End Sub

Private Function GetViewInfo(ByVal v As DrawingView) As String
    GetViewInfo = CStr(Join(Array( _
                    KCL.GetInternalName(v), _
                    v.xAxisData, _
                    v.yAxisData, _
                    v.angle _
                    ), ","))
End Function

Private Function GetViewsInfo(ByVal vs As DrawingViews) As Variant
    Dim infos() As String
    ReDim infos(vs.Count - 3)
    
    Dim i As Long
    For i = 0 To UBound(infos)
        infos(i) = GetViewInfo(vs.Item(i + 3))
    Next
    
    GetViewsInfo = infos
End Function

Private Function InitParam(ByVal s As String) As StrParam
    Dim prms As Parameters
    Set prms = GetParams()
    
    Dim prm As StrParam
    Set prm = prms.CreateString(s, "")
    
    Set InitParam = prm
End Function

' -- Common --
Private Function GetParam(ByVal s As String) As StrParam
    Dim prms As Parameters
    Set prms = GetParams()
    
    Dim prm As StrParam
    
    On Error Resume Next
        Set prm = prms.Item(s)
    On Error GoTo 0
    
    Set GetParam = prm
End Function

Private Function GetParams() As Parameters
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Set GetParams = doc.Parameters.RootParameterSet.DirectParameters
End Function

パラメータに保存する形式が以下の様に変わりました。

ビューインターナルネーム,X座標,Y座標,角度@ビューインターナルネーム,X座標,Y座標,角度@・・・

要は角度も保存するようにしました と言うことです。
Ver0.0.2以前のものは強制的に0度にしてしまいます。
(面倒だった為・・・)

ビューの位置を保存・再現

連日、不慣れなCATIAの2Dをやってきたお陰で、今まで知らなかった
機能に毎日出会ってます。
一度作った断面の位置を、変更する事が出来るなんて知りませんでしたよ・・・。
(SolidWorksFusion360では、普通に出来て羨ましいと思ってました)

相変わらず不満もあるのですが、その一つがマウスで触ってしまうと
イロイロ動いてしまう事です。
こんな感じの図面を作成したとします。
f:id:kandennti:20181102183026p:plain
右と下面図は正面図に依存した位置なのですが、断面図は依存しない
状態です。これってビューの位置をロックすると言う機能は恐らく
無いですよね? ビューをロックしても位置は動いちゃいますよね?

メーカーさんの場合あまりご存じないかも知れませんが、うちのような
孫請け末端にいると図面を位置合わせもせずにコピペで重ねて、
大まかな変更箇所を確認したりするんですよ。原始的ですが。
それを考えると、仮に設計変更が入ったとしてもビューの位置は
ズレて欲しくないんです。(欲を言えば寸法の位置も)
でも、動いちゃうんですよ。(AutoCADとかどうなんだろう?)

腹が立つので、ビューの位置を保存したり再現したりするマクロを
作りました。

※Ver0.0.3に修正した為、こちらをご覧下さい。
ビューの位置を保存・再現2 - C#ATIA

マクロを実行すると、こんなダイアログが出ます。
f:id:kandennti:20181102183052p:plain
最初は別のマクロだったのですが、ビュー位置の保存と再現するマクロを一本化
してしまった上、Formを作りたくないと言う苦肉の策です。
はい - アクティブシート上の記録されているビュー位置を再現
いいえ - アクティブシート上全てのビュー位置を保存
キャンセル - 処理中止
です。

〇保存
表示・非表示問わずに全てのビュー位置を保存します。
保存先はCATDrawingのパラメータに
"views_pos_" + シート名
の文字列型のパラメータを作成します。
パラメータ内のフォーマットは

ビューインターナルネーム,X座標,Y座標@ビューインターナルネーム,X座標,Y座標@・・・

の状態です。ビューもインターナルネームが取得出来るのですね。
その為、ビュー名を変更しても大丈夫です!!

又、同一のパラメータ名のものがある場合は、上書きの確認を行います。
f:id:kandennti:20181102183101p:plain

〇再現
上記のパラメータ名を探し出し確認ダイアログが出現します。
f:id:kandennti:20181102183110p:plain
過去に保存されていない場合は、当然再現は出来ません。
f:id:kandennti:20181102183118p:plain
又、過去に保存したのちにビューが増えている際は、警告が出ます。
f:id:kandennti:20181102183128p:plain
増えているビューに対しては位置の移動は行いません。
削除により減っているビューに対しても当然、何も行いません。

実行後は、移動の有無を表示します。
f:id:kandennti:20181102183136p:plain


確認している限りでのちょっとおかしな部分や問題点です。

〇依存との再現の矛盾
このような状態で位置を保存します。
f:id:kandennti:20181102183146p:plain
最初の状態で、断面は依存していない位置です。
ここで依存状態に戻します。
f:id:kandennti:20181102183202p:plain
依存しているので、断面は手動の場合はX方向しか動きません。
ここで再現させると
f:id:kandennti:20181102183146p:plain
元に戻ります。あくまで記録した位置になります。
但し、メインのビューをちょっとでも動かすと
f:id:kandennti:20181102183214p:plain
Y方向が依存した位置に戻ります。

〇結果のログとの矛盾
先程保存した状態からこんな感じでメインビューを動かし、
再現させます。(依存したビューは付いて来ただけです)
f:id:kandennti:20181102183231p:plain
依存しているビューは動いているのに、ログはこんな感じで
嘘を付きます。
f:id:kandennti:20181102183238p:plain
時間が出来たら直そうかな・・・。

Ver0.0.3で修正しました。

〇シート名を変更する
パラメータ名にシート名が入っている為、シート名を変更すると再現
出来なくなります。
が、上記のルールでパラメータ名を決めている為、パラメータ名を
変更する事で再現出来る様になるはずです。
逆にこれを利用すれば、位置の流用も可能かも。

〇差し替える為の新たなビューが再現されない
何らかの理由でビュー自体を差し替える為、コピーし同一のビュー名に
しても再現はされません。(言葉だと表現しにくいです)
ビュー名の重複(正面図やアイソメ図が複数出来るので)でも再現可能に
する為に、インターナルネームを利用している為です。
事前に「重ねる」等で工夫するしかないです。

〇角度が再現されない
忘れていました・・・スケールも再現しません。
あくまでXY座標だけです。ご要望があればで出来るようにしようかな?
Ver0.0.3で角度の再現は行うように、修正しました。

〇パラメータをロックしなくて良いの?
思ったより困難だったので諦めました。
Macro: Parameter, Remove constant. - DASSAULT: CATIA products - Eng-Tips


ビューの位置ってマクロだとアッサリ取得・設定出来るのですが、
手動だとわかりませんよね? プロパティとか探しても見当たらないんです。
でも、先日知りました。このツールバーで確認も移動も出来るんです。
f:id:kandennti:20181102183252p:plain
海外のサイトで教わっていた人も「そんなツールバー見たことない」って
書いてました。これも連日の発見の一つです。

無理な方向に角度寸法を入れたい

連日、何個もサポートに質問しているので、出来そうに無い事を
質問するのもさすがに気が引けてきたので、ご存知の方教えて
頂けると助かります。

f:id:kandennti:20181101152226p:plain
3Dから落とした状態です。ここからこんな感じの角度寸法を
入れたいのです。

f:id:kandennti:20181101152327p:plain
交点となる部分に中心線(とか線とか)を入れれば別に
何でも無いのですが、態々それらの要素を入れずに
この30°を作る方法はあるものでしょうか?

f:id:kandennti:20181101152409p:plain
赤と青のラインで角度を作り、セクタや補角をイロイロ
試したのですが、何れも "そこじゃない!" って所しか
出来ないんです。(もちろんCATIAは間違っていません。
間違っているのは僕なんです・・・)

実は今まで使っていたAdvance CADは、寸法を作る際
ここの寸法補助線を選択出来たりするんです。
f:id:kandennti:20181101152340p:plain
"単精度だから甘いよ" と言う情報は見たことがあるのですが。

この状態から
f:id:kandennti:20181101152518p:plain
垂直になっている方の寸法補助線を交点まで持っていく
とかって出来ないですよね。
・・・そこまでするなら "素直に線描け" って気もしてます。

オプションの設定で寸法補助線が利用出来るように
なったりしないですかね?

ファンネル2

こちらの続きです。
ファンネル - C#ATIA

どうも行き詰まり感が漂うので、とりあえずコードをUpします。

'vba Draw_SetFunnel_ver0.0.1  using-'KCL0.0.12'  by Kantoku

Option Explicit

Private Const DEF_FUNNEL_VALUE = "2,15,5"
Private Const TITLE = "ファンネル設定"

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute(Array("DrawingDocument")) Then Exit Sub
    
    Dim msg1 As String
    msg1 = "ファンネル設定値を入力して下さい (高さ,角度,幅)" & vbCrLf & _
           "例) 2,15,5 - 高さ2 角度45°幅5 外側" & vbCrLf & _
           "  2,-15,5 - 高さ2 角度45°幅5 内側" & vbCrLf & _
           "  2,0,5 -角度0°でファンネル無しと同等です"
    
    Dim msg2 As String
    msg2 = "累進寸法を選択して下さい : ESCキー ファンネル数値再設定"
    
    
    Dim funnel_value As String
    funnel_value = DEF_FUNNEL_VALUE
    
    Dim funnel As Variant
    Dim drawDim As DrawingDimension
    
    Do
        'ファンネル設定入力
        funnel_value = InputBox(msg1, TITLE, funnel_value)
        
        If StrPtr(funnel_value) = 0 Then Exit Sub
        
        funnel = ConvertFunnelValue(funnel_value)
        If Not UBound(funnel) = 3 Then Exit Do
        
        Do
            '寸法選択
            Set drawDim = SelectItem(msg2, "DrawingDimension")
            If IsNothing(drawDim) Then Exit Do
            
            '累進チェック
            If Not IsCumulateDistance(drawDim) Then
                MsgBox "累進寸法のみです!!", vbExclamation
                GoTo continue
            End If
            
            '実行
            Call ExecFunnel(drawDim, funnel(0), funnel(1), funnel(2), funnel(3))
continue:
        Loop
    Loop
    
    MsgBox "Done"
End Sub

'累進寸法判断
Private Function IsCumulateDistance(drawDim As DrawingDimension) As Boolean
    IsCumulateDistance = False
    
    With drawDim
        If .CumulateMode = False Then Exit Function
        If Not .DimType = catDimDistance Then Exit Function
    End With
    
    IsCumulateDistance = True
End Function

'入力値判断
Private Function ConvertFunnelValue(ByVal v As String) As Variant
    ConvertFunnelValue = Array(0#)
    
    Dim ary As Variant
    ary = Split(v, ",")
    
    If Not UBound(ary) = 2 Then Exit Function
    
    Dim i As Long
    For i = 0 To UBound(ary)
        If Not IsNumeric(ary(i)) Then Exit Function
    Next
    
    '角度でモード切り替え
    Dim mode As Double
    If CDbl(ary(1)) < 0 Then
        '内側
        mode = 1#
    Else
        '外側
        mode = 0#
    End If
    
    ConvertFunnelValue = Array(mode, CDbl(ary(0)), CDbl(ary(1)), CDbl(ary(2)))
End Function

'ファンネル実行
Private Sub ExecFunnel(ByVal drawDim As DrawingDimension, _
                       ByVal mode As Double, _
                       ByVal height As Double, _
                       ByVal angle As Double, _
                       ByVal width As Double)
    Dim dimExt As Variant ' DrawingDimExtLine
    Set dimExt = drawDim.GetDimExtLine
    
    If angle = 0 Then
        height = dimExt.GetOverrun(2)
        width = 0#
    End If
    Call dimExt.SetFunnel(2#, mode, Abs(angle), height, width)
End Sub

マクロを実行後インプットボックスが表示されます。
ファンネル設定値を 高さ , 角度 , 幅 の順でカンマ区切りで
入力して下さい。
f:id:kandennti:20181031200134p:plain
基本的にファンネルモードは外側です。内側にしたい場合は、
角度を0 又は 幅をマイナスの値で入力して下さい。

その後、累進寸法をクリックすることでファンネルを設定します。
マクロ実行中にファンネル設定値を変更したい場合は、ESCキーを
押す事で、再度インプットボックスが表示されます。
(その為、作業終了する際はESCキーを2度押す必要が有ります)

・・・と書くと結構良さそうに聞こえるけど、問題だらけです。

このマクロは赤印の4ヶ所のみを変更します。
f:id:kandennti:20181031200148p:plain
緑色のラジオボタンは入っていない状態でも、マクロの実行で
入ってしまいます。
逆にファンネルをOFFにしたくても、マクロでは届かない処理の
ようなので、代替として
・高さを紫色の数値に変更
・幅を0に変更
することで、見た目はファンネルをOFFと同等なる為(多分)
そのような処理をしています。

もう一点、こちらは致命傷です。
このような累進寸法を入れたとします。
f:id:kandennti:20181031200213p:plain
「30」の寸法を全てマクロを実行しクリックした
状態がこちら
f:id:kandennti:20181031200220p:plain
実に残念な結果に・・・。
原因はわかっており、ファンネルサイドがマクロを実行すると
必ず「右または上」になってしまうからなんです。
f:id:kandennti:20181031200227p:plain
せめて、両側で固定されるとありがたいのですが。

可能性が有りそうなのは、SetFunnelの第二引数のiMode
r1 DrawingDimExtLine (Object)
GetFunnelがエラーになるので、確認出来ないのが辛いです。
0~2ぐらいまでを試しただけなので何とも言えないのですが、
もっと多く試してみれば良いのかも。

とりあえず、お蔵入り・・・。