SWJUG-RING

SOLIDWORKS Japan User Group 公式コミュニティサイト

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

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

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