こちらの続きです。
寸法をクリックして直交する線を書く - C#ATIA
・・・▽▽対策のマクロです。
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
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
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
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")
Dim ojSelected As Variant
Dim winLocat(1) As Variant
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
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
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
Private Function GetDimGeoInfo( _
ByVal drwDim As DrawingDimension) As Variant
Dim dl As Variant
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 PI() As Double
PI = Atn(1) * 4
End Function
Private Function ArcCos(ByVal v As Double) As Double
ArcCos = Atn(-v / Sqr(-v * v + 1)) + 2 * Atn(1)
End Function
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
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
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
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
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
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
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
Private Function Dot2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
Dot2d = V1(0) * V2(0) + V1(1) * V2(1)
End Function
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度としています。
・マクロ実行後、2Dｺﾝﾎﾟｰﾈﾝﾄかﾃﾞｨﾃｰﾙｼｰﾄのﾋﾞｭｰを選択し、その後寸法線・寸法補助線を
クリックすることで、2Dｺﾝﾎﾟｰﾈﾝﾄをそれなりの角度・位置で配置します。
但し、意図しない場合が多いため、一旦仮の配置を行ったのちこのようなダイアログが
出る為、必要に応じて反転させてください。（y4yamaさんのもこんな感じでした、確か）
・配置する際のスケールは元のスケールを保持します。
・通常、2Dｺﾝﾎﾟｰﾈﾝﾄはアクティブなビューに配置されますが、クリックした際の寸法が
存在しているビューに配置します。こちらの "残念、そこじゃないんだよね" 対策。
寸法をクリックして直交する線を書く - C#ATIA
・マクロ的に寸法線、寸法補助線はこちらの赤印部分の座標値しか取得できません。
この四点から緑色の線を想定し、クリック位置に一番近い線を選び出し線上の座標値を
算出する仕組みになっています。クリック座標の精度の悪さとの相乗効果で、矢印付近を
クリックした際、思惑とは90度異なったものが表示される可能性が有ります。
・上記の理由から角度寸法線のような曲線に対しては、正しく配置出来ません。
角度寸法だと判断し、すれなりに計算すれば対応できるのですが、頑張れません。
あまりする必要性も無いとは思ってます。
・累進寸法でファンネルを利用している場合、正しい位置には配置出来ません。
こちらに記載した、GetFunnelメソッドがエラーなる為、値の取得が出来ないからです。
ファンネル - C#ATIA
・このマクロが一年以内の出来るだけ早い段階で不要になることを、熱望しています。
