仕事のカタマリにようこそ!  [ ログイン | ユーザ登録 ]
フォーラムから検索

機械用3D-CAD SolidWorks非公認のユーザサイトです
 
 
Web katamari.org
仕事のカタマリ
ホーム リンク集 ダウンロード フォーラム(掲示板) FAQ お問い合わせ









フォーラムニュース: 質問、相談カテゴリに「SolidWorks操作方法」に関するフォーラムを追加しました。(2003/11/27)
いらっしゃい、 ゲストさん. まずはこちら→ ログイン または 登録. 2024/04/28 - 15:08:45
ホーム ヘルプ 検索 ログイン 登録

仕事のカタマリ 掲示板  |  SolidWorks一般  |  SolidWorksのカスタマイズ (議長: webmaster)  |  トピック: スケッチ上の点のアセンブリ上での座標取得について 前のトピック 次のトピック
ページ: [1] Page Bottom 返信 返信のお知らせ Print 
   著者  トピック: スケッチ上の点のアセンブリ上での座標取得について  (閲覧数 4766 回)
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!!

プロファイルを見る WWW
Re:スケッチ上の点のアセンブリ上での座標取得について
« 返信 #5 投稿日: 2011/11/04 - 17:00:07 »
引用して返信

hyoukagizyutuさん、はじめまして

構成部品内のスケッチ点をアセンブリ座標に変換する場合、2段階の座標変換処理が必要になります。

1.スケッチ→パート(構成部品)
2.パート(構成部品)→アセンブリ

各座標系同士の関係を表すのがMathTransformとなっていて、1の場合はSketch::ModelToSketchTransformを利用します。
しかし、ModelToSketchTransformで得られるMathTransformはパート→スケッチの関係となっているので、MathTransform::Inversでスケッチ→パートにする必要があります。
そして、スケッチ座標から生成したMathPointにMathTransformを掛け合わせる(MathPoint::MultiplyTransformする)ことで、パート座標系のMathPointになります。

次に、Compmonent::Transform2で得られるパート(構成部品)→アセンブリの関係を表すMathTransformを1で変換された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さん、いつもフォローしてくれてありがとう!
議長に報告する   記録済み
ページ: [1] Page Top 返信 返信のお知らせ Print 
仕事のカタマリ 掲示板  |  SolidWorks一般  |  SolidWorksのカスタマイズ (議長: webmaster)  |  トピック: スケッチ上の点のアセンブリ上での座標取得について 前のトピック 次のトピック
ジャンプします: