| Random Thoughts |
| Ask not for whom the bell tolls, let the machine get it.
|
| 言語 |
|
|
|
| フォーラムニュース: 質問、相談カテゴリに「SolidWorks操作方法」に関するフォーラムを追加しました。(2003/11/27) |
| いらっしゃい、 ゲストさん. まずはこちら→ ログイン または 登録. 2024/11/23 - 08:17:07 |
|
     |
|
著者
|
トピック: スケッチ上の点のアセンブリ上での座標取得について (閲覧数 4987 回) |
|
hyoukagizyutu
新人さん
 オフライン
投稿: 6
I'm a llama!
|
 |
スケッチ上の点のアセンブリ上での座標取得について
« 投稿日: 2011/11/02 - 13:14:37 » |
 |
初投稿させていただきます。
アセンブリの中にあるボルト・穴・タップ位置を取得して構成に不備が無いかどうかのチェックをするような
マクロを作成しようとしております。
下記の手順でプログラムを作成しておりますが、穴位置の取得がうまくいきません。
(1)アセンブリの全ての構成部品を取得
(2)各部品のフィーチャー及びスケッチを取得
(3)原点座標（ボルト位置）の取得（フィーチャー名が「原点」「Origin」）
(4)穴・タップ位置の取得（「GetSketchPointCount」が1以上）
・・・・
(4)を取得しようとするとフィーチャー座標+スケッチ内座標（X1+X2,Y1+Y2,Z1+0）の形で出力されてしまいます。
スケッチの法線方向に関わらずスケッチ内座標（X2,Y2,0）が足されてしまうため実際とは違った値となってしまいます。
過去の投稿を参考にさせていただき色々試してみたのですがうまくいかないためどうかよろしくお願いします。
|
|
|
|
|
Makoron
カタマリの王様!?
オフライン
投稿: 1277
SW2011SP5.0
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #1 投稿日: 2011/11/02 - 16:28:19 » |
|
hyoukagizyutuさん、はじめまして。
調べてみようとは思うのですが、
サンプルを作るのが少し面倒です・・・ 
hyoukagizyutuさんのマクロから、必要な部分をサンプルとして公開していただけるといいのですが・・・。
|
|
|
|
|
hyoukagizyutu
新人さん
オフライン
投稿: 6
I'm a llama!
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #2 投稿日: 2011/11/02 - 17:24:39 » |
|
Makoronさん
ご返信ありがとうございます。
下記にプログラムをコピーします。
色々と試行錯誤しておりますので、余計なコードがあったりして見づらいかも
しれませんがご容赦ください。
Option Explicit
Private swApp As SldWorks.SldWorks
Sub main()
Set swApp = CreateObject("SldWorks.Application")
' アセンブリドキュメントを開く
Dim swModelDoc2 As SldWorks.ModelDoc2
Dim swAssemblyDoc As SldWorks.AssemblyDoc
Dim lngType As Long: lngType = swDocumentTypes_e.swDocASSEMBLY
Dim lngOptions As Long: lngOptions = swOpenDocOptions_e.swOpenDocOptions_Silent
Dim strConfig As String: strConfig = ""
Dim lngErrors As Long
Dim lngWarnings As Long
Set swAssemblyDoc = swModelDoc2
Set swAssemblyDoc = swApp.ActiveDoc
Dim FeatureData As SldWorks.WizardHoleFeatureData2
Dim ncount As Long
Dim spoint As Long
Dim swSketch As SldWorks.Sketch
Dim swSketchPt As SldWorks.SketchPoint
Dim vSketchPtArr As Variant
Dim vSketchPt As Variant
Dim nPtData(2) As Double
Dim vPtArr As Variant
'Dim bRet As Boolean
Dim swPt As SldWorks.MathPoint
Dim swMathUtil As SldWorks.MathUtility
Dim swSketchXform As SldWorks.MathTransform
Dim swModel As SldWorks.ModelDoc2
Dim Measure As Measure
Dim boolstatus As Boolean
'ファイルの見出し
Open "c:\test.csv" For Append As #3
Print #3, "モデル名,フィーチャー名,X座標,Y座標,Z座標"
Close #3
' アセンブリの全ての構成部品を取得
Dim vntComponents As Variant
vntComponents = swAssemblyDoc.GetComponents(False)
If IsEmpty(vntComponents) = True Then
Exit Sub
End If
' 各構成部品のフィチャー及びスケッチを取得
Dim i As Long
Dim swComponent2 As SldWorks.Component2
Dim swCompModelDoc2 As SldWorks.ModelDoc2
Dim swCompFeature As SldWorks.Feature
Dim swCompSketch As SldWorks.Sketch
'--------原点の取得--------
For i = 0 To UBound(vntComponents)
' Component2オブジェクトを取得
Set swComponent2 = vntComponents(i)
' 構成部品のModelDoc2オブジェクトを取得
If swComponent2.IsSuppressed Then
' 構成部品が抑制状態の場合
Debug.Print " 抑制されています!"
Set swCompModelDoc2 = Nothing
Else
' 構成部品が抑制解除の場合
Set swCompModelDoc2 = swComponent2.GetModelDoc
End If
' 構成部品のフィーチャーを取得
If Not swCompModelDoc2 Is Nothing Then
Set swCompFeature = swCompModelDoc2.FirstFeature
Do While Not swCompFeature Is Nothing
Set FeatureData = swCompFeature.GetDefinition
'エラーを無視
On Error Resume Next
If swCompFeature.Name = "原点" Or swCompFeature.Name = "Origin" Then
Debug.Print " PatternFeatureCount = " & FeatureData.GetPatternFeatureCount
'パート名取得
Debug.Print "----- " & swComponent2.Name2 & " -----"
'フィーチャー名取得
Debug.Print " " & swCompFeature.Name
'絶対座標に変換?
Set swSketchXform = swComponent2.Transform2
Set swMathUtil = swApp.GetMathUtility
'スケッチの点を取得
vSketchPtArr = FeatureData.GetSketchPoints
For Each vSketchPt In vSketchPtArr
Set swSketchPt = vSketchPt
nPtData(0) = swSketchPt.X
nPtData(1) = swSketchPt.Y
nPtData(2) = swSketchPt.Z
vPtArr = nPtData
Set swPt = swMathUtil.CreatePoint(vPtArr)
Set swPt = swPt.MultiplyTransform(swSketchXform)
'アセンブリでの位置
Debug.Print Round(swPt.ArrayData(0) * 1000#, 3) & " " & Round(swPt.ArrayData(1) * 1000#, 3) & " " & Round(swPt.ArrayData(2) * 1000#, 3)
'csvファイルへの書き出し
Open "c:\test.csv" For Append As #3
Print #3, swComponent2.Name2 & "," & swCompFeature.Name & "," & Round(swPt.ArrayData(0) * 1000#, 3) & "," & Round(swPt.ArrayData(1) * 1000#, 3) & "," & Round(swPt.ArrayData(2) * 1000#, 3)
Close #3
Next
End If
' Debug.Print " " & swCompFeature.Name
Set swCompFeature = swCompFeature.GetNextFeature
Loop
End If
Next
'--------穴位置の取得--------
For i = 0 To UBound(vntComponents)
' Component2オブジェクトを取得
Set swComponent2 = vntComponents(i)
' 構成部品のModelDoc2オブジェクトを取得
If swComponent2.IsSuppressed Then
' 構成部品が抑制状態の場合
Debug.Print " 抑制されています!"
Set swCompModelDoc2 = Nothing
Else
' 構成部品が抑制解除の場合
Set swCompModelDoc2 = swComponent2.GetModelDoc
End If
' 構成部品のフィーチャーを取得
If Not swCompModelDoc2 Is Nothing Then
Set swCompFeature = swCompModelDoc2.FirstFeature
Do While Not swCompFeature Is Nothing
Set FeatureData = swCompFeature.GetDefinition
'エラーを無視
On Error Resume Next
'穴ウィザードの点の数を取得
ncount = FeatureData.GetSketchPointCount
If Not Left(swCompFeature.Name, 2) = "面取" And Not Left(swCompFeature.Name, 5) = "ﾌｨﾚｯﾄ" And Not Left(swCompFeature.Name, 4) = "ｾﾝｻｰ" Then
If ncount <> 0 Then
Debug.Print " PatternFeatureCount = " & FeatureData.GetPatternFeatureCount
'パート名取得
Debug.Print "----- " & swComponent2.Name2 & " -----"
'フィーチャー名取得
Debug.Print " " & swCompFeature.Name
'穴の直径を取得
'Debug.Print " 穴数 = " & ncount
'Debug.Print " 丸皿ねじ穴直径（43・44） = " & swWizHole.HoleDiameter * 1000# & " mm"
'Debug.Print " タップ直径（46・48） = " & swWizHole.ThreadDiameter * 1000# & " mm"
'Debug.Print " タップ下穴直径（46） = " & swWizHole.TapDrillDiameter * 1000# & " mm"
'Debug.Print " 貫通タップ直径（48） = " & swWizHole.ThruTapDrillDiameter * 1000# & " mm"
'Debug.Print " 穴直径（14・25） = " & swWizHole.ThruHoleDiameter * 1000# & " mm"
'穴の種類を取得
'Debug.Print " Type = " & swWizHole.Type
'絶対座標に変換?
Set swSketchXform = swComponent2.Transform2
Set swMathUtil = swApp.GetMathUtility
'スケッチの点を取得
vSketchPtArr = FeatureData.GetSketchPoints
For Each vSketchPt In vSketchPtArr
Set swSketchPt = vSketchPt
nPtData(0) = swSketchPt.X
nPtData(1) = swSketchPt.Y
nPtData(2) = swSketchPt.Z
vPtArr = nPtData
Set swPt = swMathUtil.CreatePoint(vPtArr)
Set swPt = swPt.MultiplyTransform(swSketchXform)
'パートでの位置
Debug.Print nPtData(0) * 1000# & " " & nPtData(1) * 1000# & " " & nPtData(2) * 1000#
'アセンブリでの位置
Debug.Print Round(swPt.ArrayData(0) * 1000#, 3) & " " & Round(swPt.ArrayData(1) * 1000#, 3) & " " & Round(swPt.ArrayData(2) * 1000#, 3)
'csvファイルへの書き出し
Open "c:\test.csv" For Append As #3
Print #3, swComponent2.Name2 & "," & swCompFeature.Name & "," & Round(nPtData(0) * 1000#, 3) & "," & Round(nPtData(1) * 1000#, 3) & "," & Round(nPtData(2) * 1000#, 3)
Close #3
nPtData(0) = 0
nPtData(1) = 0
nPtData(2) = 0
Next
End If
End If
ncount = 0
'Debug.Print " " & swCompFeature.Name
Set swCompFeature = swCompFeature.GetNextFeature
Loop
End If
Next
End Sub
|
|
|
|
|
Makoron
カタマリの王様!?
オフライン
投稿: 1277
SW2011SP5.0
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #3 投稿日: 2011/11/04 - 12:39:20 » |
|
hyoukagizyutuさん、こんにちは。
掲載していただいたプログラムコードを元に、作成してみました。
この様なプログラムをほとんど作成しないので、すごく勉強になりました！！
ほぼ原型をとどめていませんが、私なりに考えて、そしてトライしながらサンプルを作ってみました。
Transform あたりの考え方が正しいのか、まだ、不安はありますが、
テストでは正しい座標が取得できました。
ちなみに、掲載していただいたプログラムでは穴ウィザード以外の座標を取得していましたが、
穴ウィザードのみ処理するように変更してしまいました 
Code:Option Explicit
Private swApp As SldWorks.SldWorks
Sub main()
Set swApp = CreateObject("SldWorks.Application")
' アセンブリドキュメントを開く
Dim swModelDoc2 As SldWorks.ModelDoc2
Dim swAssemblyDoc As SldWorks.AssemblyDoc
Set swModelDoc2 = swApp.ActiveDoc
Set swAssemblyDoc = swModelDoc2
Dim swMathUtil As SldWorks.MathUtility
Set swMathUtil = swApp.GetMathUtility
'ファイルの見出し
Open "c:\test.csv" For Append As #3
Print #3, "モデル名,フィーチャー名,X座標,Y座標,Z座標"
Close #3
' アセンブリの全ての構成部品を取得
Dim vntComponents As Variant
vntComponents = swAssemblyDoc.GetComponents(False)
If IsEmpty(vntComponents) = True Then
Exit Sub
End If
' 各構成部品のフィチャー及びスケッチを取得
Dim i As Long
For i = 0 To UBound(vntComponents)
' Component2オブジェクトを取得
Dim swComponent2 As SldWorks.Component2
Set swComponent2 = vntComponents(i)
' 構成部品名の取得
Dim strCompName As String
strCompName = swComponent2.Name2
' 構成部品のModelDoc2オブジェクトを取得
Dim swCompModelDoc2 As SldWorks.ModelDoc2
Set swCompModelDoc2 = swComponent2.GetModelDoc
If swComponent2.IsSuppressed Then
Set swCompModelDoc2 = Nothing
Debug.Print " 抑制されています!"
End If
' 構成部品のフィーチャーを取得
If Not swCompModelDoc2 Is Nothing Then
' 構成部品の原点座標を取得
Dim swCompTransform As SldWorks.MathTransform
Dim dblCompX As Double
Dim dblCompY As Double
Dim dblCompZ As Double
Set swCompTransform = swComponent2.Transform2
dblCompX = swCompTransform.ArrayData(9)
dblCompY = swCompTransform.ArrayData(10)
dblCompZ = swCompTransform.ArrayData(11)
' 構成部品の原点座標と穴ウィザード座標を書き出し
Dim swCompFeature As SldWorks.Feature
Dim strFeatureName As String
Dim strFeatureX As String
Dim strFeatureY As String
Dim strFeatureZ As String
Set swCompFeature = swCompModelDoc2.FirstFeature
Do While Not swCompFeature Is Nothing
' フィーチャの種類名を取得
Dim strFeatureTypeName As String
strFeatureTypeName = swCompFeature.GetTypeName
' 原点
If strFeatureTypeName = "OriginProfileFeature" Then
' フィーチャ名取得
strFeatureName = swCompFeature.Name
' 座標取得
strFeatureX = Round(dblCompX * 1000#, 3)
strFeatureY = Round(dblCompY * 1000#, 3)
strFeatureZ = Round(dblCompZ * 1000#, 3)
' csvファイルへの書き出し
Open "c:\test.csv" For Append As #3
Print #3, strCompName & "," & strFeatureName & "," & strFeatureX & "," & strFeatureY & "," & strFeatureZ
Close #3
Debug.Print strCompName & "," & strFeatureName & "," & strFeatureX & "," & strFeatureY & "," & strFeatureZ
End If
' 穴ウィザード
If strFeatureTypeName = "HoleWzd" Then
' フィーチャ名取得
strFeatureName = swCompFeature.Name
' 穴ウィザードデータの取得
Dim swWizardHoleFeatureData2 As SldWorks.WizardHoleFeatureData2
Set swWizardHoleFeatureData2 = swCompFeature.GetDefinition
'スケッチの点を取得
Dim vntSketchPoints As Variant
Dim vntSketchPoint As Variant
Dim swSketchPoint As SldWorks.SketchPoint
vntSketchPoints = swWizardHoleFeatureData2.GetSketchPoints
For Each vntSketchPoint In vntSketchPoints
' スケッチ点情報の取得
Set swSketchPoint = vntSketchPoint
Dim dblPointX As Double
Dim dblPointY As Double
Dim dblPointZ As Double
dblPointX = swSketchPoint.X
dblPointY = swSketchPoint.Y
dblPointZ = swSketchPoint.Z
' スケッチ位置情報の取得
Dim swSketch As SldWorks.Sketch
Dim swSketchTransform As SldWorks.MathTransform
Dim dblSketchX As Double
Dim dblSketchY As Double
Dim dblSketchZ As Double
Set swSketch = swSketchPoint.GetSketch
Set swSketchTransform = swSketch.ModelToSketchTransform
dblSketchX = swSketchTransform.ArrayData(9)
dblSketchY = swSketchTransform.ArrayData(10)
dblSketchZ = swSketchTransform.ArrayData(11)
' 座標取得
strFeatureX = Round((dblCompX - dblSketchX + dblPointX) * 1000#, 3)
strFeatureY = Round((dblCompY - dblSketchY + dblPointY) * 1000#, 3)
strFeatureZ = Round((dblCompZ - dblSketchZ + dblPointZ) * 1000#, 3)
' csvファイルへの書き出し
Open "c:\test.csv" For Append As #3
Print #3, strCompName & "," & strFeatureName & "," & strFeatureX & "," & strFeatureY & "," & strFeatureZ
Close #3
Debug.Print strCompName & "," & strFeatureName & "," & strFeatureX & "," & strFeatureY & "," & strFeatureZ
Next
End If
' 次のフィーチャを取得
Set swCompFeature = swCompFeature.GetNextFeature
Loop
End If
Next
End Sub
|
|
|
|
|
|
hyoukagizyutu
新人さん
オフライン
投稿: 6
I'm a llama!
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #4 投稿日: 2011/11/04 - 14:54:09 » |
|
Makoronさん お世話になります。
プログラムの確認させていただきました。ありがとうございます。
とてもきれいにまとまっていましたので大変参考になりました。
穴・タップ位置の座標ですが数字自体は問題なく取得されていましたが、
やはりスケッチ座標系が基準となっているらしく（X,Y,Z）の並び順が
正しく出力されません。アセンブリのXY平面とスケッチのXY平面の方向の
関係性によって値が入れ替わってしまうみたいです。
（例）Y方向厚み20mmの立方体でX：-25 Y:20 Z:25の位置にM3のタップ穴とボルトを
アセンブリしたものに対してマクロを実行した場合。
・出力結果
モデル名 フィーチャー名 X座標 Y座標 Z座標
Part1-1 原点 0 0 0
Part1-1 M3x0.5 ねじ穴1 25 25 20
Hexagon Socket Head Cap Screw_JIS-1 Origin -25 23 25
・欲しい結果
モデル名 フィーチャー名 X座標 Y座標 Z座標
Part1-1 原点 0 0 0
Part1-1 M3x0.5 ねじ穴1 -25 20 25
Hexagon Socket Head Cap Screw_JIS-1 Origin -25 23 25
アセンブリに対するスケッチの法線方向が取得できればベクトル演算で
値が補正できるかなと考えています。
また「measure」でアセンブリ原点とスケッチ点の測定を行えればもっと
簡単に値が取得できるのではと思うのですが、サンプルプログラムでは
対象を選択した状態でのものしかなかったためこれを今回のプログラムに
組み込むところで詰まってしまいました。
もしよろしければ、再度お力をお貸しください。
|
|
|
|
|
hisa
カタマリの王様!?
オフライン
投稿: 507
PANDA-Z!!
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #5 投稿日: 2011/11/04 - 17:00:07 » |
|
hyoukagizyutuさん、はじめまして 
構成部品内のスケッチ点をアセンブリ座標に変換する場合、2段階の座標変換処理が必要になります。
１．スケッチ→パート(構成部品)
２．パート(構成部品)→アセンブリ
各座標系同士の関係を表すのがMathTransformとなっていて、１の場合はSketch::ModelToSketchTransformを利用します。
しかし、ModelToSketchTransformで得られるMathTransformはパート→スケッチの関係となっているので、MathTransform::Inversでスケッチ→パートにする必要があります。
そして、スケッチ座標から生成したMathPointにMathTransformを掛け合わせる(MathPoint::MultiplyTransformする)ことで、パート座標系のMathPointになります。
次に、Compmonent::Transform2で得られるパート(構成部品)→アセンブリの関係を表すMathTransformを１で変換されたMathPointに掛け合わせることで、
晴れてスケッチ→アセンブリの変換が可能になります。
MathTransformの9〜10番目の要素で得られる値は、hyoukagizyutuの考えている通りスケッチ面や構成部品の傾きが考慮されていないので、足し算する前に傾きを考慮する必要があります。
その部分を簡単にしてくれているのが、MathTransformとMultiplyTransformです。
最初のうちは、構成部品→アセンブリなのかアセンブリ→構成部品なのかややこしい感じですが、実際に色々試すとつかめると思います 
(特にスケッチ→パートは混乱しました･･･  )
とりあえず、スケッチ→アセンブリ座標変換のサンプルを載せますね。
Code:Option Explicit
Dim swMathUtil As SldWorks.MathUtility
Sub Traverse_CompFeature(swComp As SldWorks.Component2)
Dim swCompXform As SldWorks.MathTransform
Dim swMathPt As SldWorks.MathPoint
Dim swFeat As SldWorks.Feature
Dim swWizHoleData As SldWorks.WizardHoleFeatureData2
Dim swSketchPt As SldWorks.SketchPoint
Dim swSketch As SldWorks.Sketch
Dim swSketchXform As SldWorks.MathTransform
Dim vPoints, p As Variant
Dim vPt(2) As Double
' 構成部品→TOPアセンブリのTransform取得
Set swCompXform = swComp.Transform2
' 最初のフィーチャー取得
Set swFeat = swComp.FirstFeature
' フィーチャー巡回
While Not (swFeat Is Nothing)
' 穴ウィザード判定
If swFeat.GetTypeName2 = "HoleWzd" Then
' 穴ウィザードデータ取得
Set swWizHoleData = swFeat.GetDefinition
' 一応スケッチ点の数判定
If swWizHoleData.GetSketchPointCount > 0 Then
' スケッチ点取得
vPoints = swWizHoleData.GetSketchPoints
' 一つ目の点から親スケッチ取得
Set swSketch = vPoints(0).GetSketch
' スケッチ→モデル(構成部品)のTransform取得
Set swSketchXform = swSketch.ModelToSketchTransform
Set swSketchXform = swSketchXform.Inverse
' スケッチ点巡回
For Each p In vPoints
Set swSketchPt = p
' スケッチ点座標取り出し
vPt(0) = swSketchPt.X
vPt(1) = swSketchPt.Y
vPt(2) = swSketchPt.Z
' スケッチでの位置
Debug.Print vPt(0) * 1000#, vPt(1) * 1000#, vPt(2) * 1000#
' 点座標からMathPoint生成
Set swMathPt = swMathUtil.CreatePoint(vPt)
' スケッチ→モデル(構成部品)座標変換
Set swMathPt = swMathPt.MultiplyTransform(swSketchXform)
' パートでの位置
Debug.Print swMathPt.ArrayData(0) * 1000#, swMathPt.ArrayData(1) * 1000#, swMathPt.ArrayData(2) * 1000#
' 構成部品→TOPアセンブリ座標変換
Set swMathPt = swMathPt.MultiplyTransform(swCompXform)
Debug.Print swMathPt.ArrayData(0) * 1000#, swMathPt.ArrayData(1) * 1000#, swMathPt.ArrayData(2) * 1000#
Next
End If
End If
Set swFeat = swFeat.GetNextFeature
Wend
End Sub
Sub Traverse_Comp(swComp As SldWorks.Component2)
Dim vChild As Variant
Dim swChildComp As SldWorks.Component2
Dim i As Long
Debug.Print swComp.Name2
Traverse_CompFeature swComp
If swComp.IsSuppressed = False Then
vChild = swComp.GetChildren
For i = 0 To UBound(vChild)
Set swChildComp = vChild(i)
Traverse_Comp swChildComp
Next i
End If
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swMathUtil = swApp.GetMathUtility
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent
Debug.Print "トップアセンブリ: " & swModel.GetPathName
Traverse_Comp swRootComp
Set swMathUtil = Nothing
End Sub |
|
|
|
|
|
hyoukagizyutu
新人さん
オフライン
投稿: 6
I'm a llama!
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #6 投稿日: 2011/11/07 - 08:50:06 » |
|
hisaさん
お世話になります。
ご教示いただきました内容にてMakoronさんの作成いただいたプログラムを変更したところ、
こちらの意図した通りのデータを取得することができました。
Makoronさん、hisaさん ありがとうございました。
以下、変更部分です。
For Each vntSketchPoint In vntSketchPoints
' スケッチ点情報の取得
Set swSketchPoint = vntSketchPoint
Dim dblPointX As Double
Dim dblPointY As Double
Dim dblPointZ As Double
dblPointX = swSketchPoint.X
dblPointY = swSketchPoint.Y
dblPointZ = swSketchPoint.Z
' スケッチ位置情報の取得
Dim swSketch As SldWorks.Sketch
Dim swSketchTransform As SldWorks.MathTransform
Dim dblSketchX As Double
Dim dblSketchY As Double
Dim dblSketchZ As Double
Set swSketch = swSketchPoint.GetSketch
Set swSketchTransform = swSketch.ModelToSketchTransform
Set swSketchTransform = swSketchTransform.Inverse
Dim swMathPt As SldWorks.MathPoint
' スケッチ点座標取り出し
Dim vPt(2) As Double
vPt(0) = vntSketchPoint.X
vPt(1) = vntSketchPoint.Y
vPt(2) = vntSketchPoint.Z
' 点座標からMathPoint生成
Set swMathPt = swMathUtil.CreatePoint(vPt)
' スケッチ→モデル(構成部品)座標変換
Set swMathPt = swMathPt.MultiplyTransform(swSketchTransform)
' 構成部品→TOPアセンブリ座標変換
Set swMathPt = swMathPt.MultiplyTransform(swCompTransform)
' csvファイルへの書き出し
Open "c:\test.csv" For Append As #3
Print #3, strCompName & "," & strFeatureName & "," & swMathPt.ArrayData(0) * 1000# & "," & swMathPt.ArrayData(1) * 1000# & "," & swMathPt.ArrayData(2) * 1000#
Close #3
Debug.Print swMathPt.ArrayData(0) * 1000#, swMathPt.ArrayData(1) * 1000#, swMathPt.ArrayData(2) * 1000#
Next
|
|
|
|
|
Makoron
カタマリの王様!?
オフライン
投稿: 1277
SW2011SP5.0
|
|
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #7 投稿日: 2011/11/07 - 08:58:14 » |
|
hyoukagizyutuさん、うまくいって良かったですね！
hisaさん、いつもフォローしてくれてありがとう！
|
|
|
|
|
|
|
|
|
記録済み