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

読み込んだファイルをそのまま配置する分には問題がないのですが、部品を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

問題なく動いております。一番自分の使い方にあっていたのは「AddComponents」の方でした。どうもありがとうございました

いろいろご意見やご提案頂きありがとうございます

現在なかなか時間が取れず検証ができていませんが、結果が出ましたらまたご報告させていただきます。

取り敢えず中間報告という事で・・・

"AddComponents3"と辻さんから紹介があった"AddComponents"です。

ご参考になれば、、、

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

マストランスフォームは１６個の数値配列ですが、最初の０から８までが３X3の行列でX,Y,Zの向きを、９から１１がX,Y,Zの座標を、１２がスケールを表しています。（１３から１５は不使用）

９０度回転とのことなので、３行のうち２行の１（－１）とする列を入れ替えることで回転させることが出来ると思います。

＜ｚ軸を中心に９０度回転の例＞

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

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

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

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

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

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

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

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