部品を90度回転して配置する

基板に抵抗などの部品を配置するマクロを作成しました。

あらかじめ配置位置データを作っておき、その位置データを元に部品データを読み込んで配置するというものです

読み込んだファイルをそのまま配置する分には問題がないのですが、部品を90度回転させて配置させなければならない個所もありどうにか部品を回転させて配置したいと思うのですが、マクロの記録を使っても部品を回転させた記録は残らず困っており、お教え頂ければ助かります。

因みに現在私が使っているマクロは以下の通りです。済みませんがよろしくお願いします

' ******************************************************************************
'予めX値、Y値、Z値をスペースで区切ったテキストデータファイルを準備しておく
'*****************************************************************************
Dim swapp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Dim swapp As SldWorks.SldWorks
Dim Filter As String
Dim fileName As String
Dim fileConfig As String
Dim fileDispName As String
Dim fileOptions As Long
Dim Chk As Integer
Dim Fname As String
Dim ItiX As Single
Dim ItiY As Single
Dim ItiZ As Single
Dim buf As String
Dim Kfname As String
Dim Fld As String
Dim Sname As String
Dim N As Integer
Dim Tname As String
Dim KariSt As String

 

Set swapp = Application.SldWorks

Set Part = swapp.ActiveDoc
Dim myModelView As Object

Filter = "全部|*.*|"
MsgBox ("データファイルを選択してください")


Fname = swapp.GetOpenFileName("Select File", "", Filter, fileOptions, fileConfig, fileDispName) '位置情報データ

If Fname = "" Then
    MsgBox ("ファイルが検出できません")
  
    MsgBox ("中断します")
    Exit Sub
End If

 

 

    MsgBox ("パーツデータがあるファイルを選択してください。")
    fileName = swapp.GetOpenFileName("Select File", "", Filter, fileOptions, fileConfig, fileDispName)
   
    If Kfname = "" Then
        MsgBox ("ファイルが検出できません")
      
        MsgBox ("中断します")
        Exit Sub
    End If
   

Open Fname For Input As #1

Do Until EOF(1)

    Line Input #1, buf
    If buf = "" Then
        Exit Do
    End If
    Chk = XYZget(ItiX, ItiY, ItiZ, buf)
    If Chk <> 3 Then
        MsgBox ("番目に読み込みエラーがありましたので中断します")
        Exit Sub
    End If

    boolstatus = Part.AddComponent(fileName, ItiX, ItiY, ItiZ)


Loop

Close

MsgBox ("読み込みました")

End Sub

Function XYZget(ItX As Single, ItY As Single, ItZ As Single, buf As String) As Integer

Dim KariSt As String
Dim KrX As String
Dim KrY As String
Dim KrZ As String
Dim Ln As Integer
Dim N As Integer
Dim Chk As Integer

KariSt = ""
Ln = Len(buf)
Chk = 0

For N = 1 To Ln
    If Mid(buf, N, 1) <> " " Then
        KariSt = KariSt + Mid(buf, N, 1)
    Else
        If Chk = 0 Then
            KrX = KariSt
            KariSt = ""
            Chk = 1
        ElseIf Chk = 1 Then
            KrY = KariSt
            KariSt = ""
            Chk = 2
        ElseIf Chk = 2 Then
            KrZ = KariSt
            Chk = 3
            KariSt = ""
        Else
            Chk = 4
            Exit For
        End If
    End If
Next

If Chk = 2 Then
    KrZ = KariSt
    Chk = 3
End If

ItX = Val(KrX)
ItY = Val(KrY)
ItZ = Val(KrZ)


XYZget = Chk
       

 

End Function

 

 

 

コメント

コメント表示順: リミット: オートロード:
  • 辻 直樹 4 日前

    使ったことはないので不確かですが、、、との前置きをしたうえで

    横網代さんが紹介されている”3”も含めて、"AddComponents"(s付きに注意)なら、パラメータの"Transforms"部分に回転させた状態と位置のマストランスフォームを設定すれば良いのではないでしょうか。

    マストランスフォームは16個の数値配列ですが、最初の0から8までが3X3の行列でX,Y,Zの向きを、9から11がX,Y,Zの座標を、12がスケールを表しています。(13から15は不使用)

    90度回転とのことなので、3行のうち2行の1(-1)とする列を入れ替えることで回転させることが出来ると思います。

    <z軸を中心に90度回転の例>

    1,0,0      0,1,0   0,-1,0

    0,1,0 → -1,0,0 or 1,0,0

    0,0,1    0,0,1   0, 0,1

    座標のテキストファイルに回転を表す1列を追加して(必要なら回転方向も識別)、それによってマストランスフォームの0から8の設定を選択するようでしょうか。

  • 横網代 秀幸 4 日前

    部品データに座標系をいくつか作っておいて"AddComponents3"を使うのはどうでしょう?

     

    X,Y,Zに加えて、向き制御用のFlagを用意して対応する座標系を割り当てる、、、こんな感じ?

    (ほぼHELPからのコピペ)

     

    Dim swApp As SldWorks.SldWorks
    Dim assemb As AssemblyDoc
    Dim compNames(0) As String
    Dim compXforms(15) As Double
    Dim compCoordSysNames(0) As String
    Dim vcompNames As Variant
    Dim vcompXforms As Variant
    Dim vcompCoordSysNames As Variant
    Dim vcomponents As Variant

    Option Explicit

    Sub main()

    Set swApp = Application.SldWorks
    Set assemb = swApp.ActiveDoc


    compXforms(0) = 1#
    compXforms(1) = 0#
    compXforms(2) = 0#
    compXforms(3) = 0#
    compXforms(4) = 1#
    compXforms(5) = 0#
    compXforms(6) = 0#
    compXforms(7) = 0#
    compXforms(8) = 1#
    compXforms(12) = 1#


    '繰り返し処理~
     Call AddComps("C:\temp\Part1.SLDPRT", 50, 0, 50, 0)

    '~繰り返し処理


    End Sub


    Sub AddComps(CompName As String, X As Double, Y As Double, Z As Double, rFlag As Integer)

    compNames(0) = CompName

    compXforms(9) = X / 1000
    compXforms(10) = Y / 1000
    compXforms(11) = Z / 1000


    Select Case rFlag
     Case 0
      compCoordSysNames(0) = "座標系1" '
     Case 1
      compCoordSysNames(0) = "座標系2" '90°回転の座標を作っておく
    End Select


    vcompNames = compNames
    vcompXforms = compXforms

    vcompCoordSysNames = compCoordSysNames
    vcomponents = assemb.AddComponents3((vcompNames), (vcompXforms), (vcompCoordSysNames))


    End Sub

  • 山本誠 4 日前

    正しい方法かはわからないけど...

    部品を挿入した後に”非固定”にして。
    合致で参照平面同士を合致させる。
    部品を再度”固定”にする。(しなくても良い)
    という方法はどうでしょうか?

    合致によってXYZを合わせつつ、回転方向も調整することになるので
    いろいろトライしなければいけないかもですが、
    うまく行けばマクロを実現できると思います。

  • 柴田幸 4 日前

    いろいろと調べてみましたがmacroでcomponentを回転させるのって意外と難しいんですね。

    もし読み込む部品の数がそんなに多くないのなら読み込む部品の方に回転したコンフィグを

    作っておいてaddcomponent5のコンフィグオプションで選ぶというのも良さそうですが、

    読み込む部品が沢山あったり部品をいじる権限がなかったりすると無理ですね。