Imports Find Imports AlibreX Imports PowerPCB Public Class Form1 Public PPads As Object Public Padsbutton As Boolean = False Public BT_Anzahl As Integer Public Comp As Object Public bt_select As Integer Dim Zaehler As Integer = 1 Public Lp_File As String Public Lib_Path As String = "K:\" Public Model As String Public LP_Staerke As Double Public RV(0 To 15) As Double Public Structure Bauteil Dim Name As String Dim PosX As Double Dim PosY As Double Dim Rot As Double Dim Layer As Integer Dim CadName As String End Structure Public bt(0 To 999) As Bauteil Public ListSel As String Public Datentext As String Dim x As Integer Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click PPads = Nothing End End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click PPads = GetObject(, "PowerPCB.Application") If PPads Is Nothing Then 'PPads.VB_VarHelpID = -1 Label2.Text = "???????" Exit Sub Else Button1.Text = "Connected" Label2.Text = PPads.ActiveDocument.Name Button3.Enabled = True End If End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim Comp As PowerPCB.IPowerPCBComp ListBox1.Items.Clear() ListBox2.Items.Clear() BT_Anzahl = 0 bt_select = 0 Zaehler = 1 BT_Anzahl = PPads.ActiveDocument.Components.count '********************************* Bauteile mit 3D-Verweis zählen ********************* If RadioButton2.Checked = True Then For Each Comp In PPads.ActiveDocument.Components If Comp.selected = (True) Then bt_select = bt_select + 1 End If Next ReDim bt(0 To bt_select) Else ReDim bt(0 To BT_Anzahl) End If Label4.Text = bt_select Label10.Text = BT_Anzahl '********************************************************************************************* '* '*************************** Daten zuweisen selectierte Bauteile ***************************** If RadioButton2.Checked = True Then For Each Comp In PPads.ActiveDocument.Components If Comp.selected = True And (bt_select > 0) Then bt(Zaehler).Name = Comp.Name bt(Zaehler).PosX = Comp.CenterX bt(Zaehler).PosY = Comp.CenterY bt(Zaehler).Rot = Comp.Orientation bt(Zaehler).Layer = Comp.layer If Not Comp.Attributes("Geometry.Model") Is Nothing Then bt(Zaehler).CadName = Find.SearchFile.FindFile(Lib_Path, Comp.Attributes("Geometry.Model").value) ListBox2.Items.Add(bt(Zaehler).Name) Else bt(Zaehler).CadName = "undefiniert" ListBox1.Items.Add(bt(Zaehler).Name) End If Zaehler = Zaehler + 1 End If Next '********************************************************************************** '* '********************** Daten zuweisen alle Bauteile **************************** Else For Each Comp In PPads.ActiveDocument.Components bt(Zaehler).Name = Comp.Name bt(Zaehler).PosX = Comp.CenterX bt(Zaehler).PosY = Comp.CenterY bt(Zaehler).Rot = Comp.Orientation bt(Zaehler).Layer = Comp.layer If Not Comp.Attributes("Geometry.Model") Is Nothing Then bt(Zaehler).CadName = Find.SearchFile.FindFile(Lib_Path, Comp.Attributes("Geometry.Model").value) ListBox2.Items.Add(bt(Zaehler).Name) Else bt(Zaehler).CadName = "undefiniert" ListBox1.Items.Add(bt(Zaehler).Name) End If Zaehler = Zaehler + 1 Next End If '***************************************************************************************** End Sub Private Sub ListBox2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox2.SelectedIndexChanged ListSel = ListBox2.SelectedItem PPads.ActiveDocument.SelectObjects(, , False) PPads.ActiveDocument.Components(ListSel).Selected = True End Sub Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged ListSel = ListBox1.SelectedItem PPads.ActiveDocument.SelectObjects(, , False) PPads.ActiveDocument.Components(ListSel).Selected = True End Sub Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged End Sub Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk End Sub Private Sub Label5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label5.Click End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click OpenFileDialog1.Filter = "AD_PRT-Datei (*.AD_PRT)| *.AD_PRT" If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then Lp_File = OpenFileDialog1.FileName TextBox2.Text = Lp_File If Lp_File <> "" Then bt(0).Name = "Leiterplatte" bt(0).Layer = 1 bt(0).CadName = Lp_File End If End If End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Datentext = "" For x = 0 To (Zaehler - 1) Datentext = Datentext & "BT(" & x & ")" & vbCrLf Datentext = Datentext & CStr(bt(x).Name) & vbCrLf Datentext = Datentext & bt(x).PosX & vbCrLf Datentext = Datentext & bt(x).PosY & vbCrLf Datentext = Datentext & bt(x).Rot & vbCrLf Datentext = Datentext & bt(x).Layer & vbCrLf Datentext = Datentext & bt(x).CadName & vbCrLf Datentext = Datentext & "#############" & vbCrLf Next TextBox1.Text = Datentext End Sub Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click If FolderBrowserDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then Lib_Path = FolderBrowserDialog1.SelectedPath TextBox3.Text = Lib_Path End If End Sub Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click Button4.Enabled = False If (Lp_File = "") Or (CStr(LP_Staerke) = "") Or (Lib_Path = "") Then MsgBox("Eine Eingabe in den Feldern 3D-Model, LP-Eigenschaften oder Bauteil-Suchfpad fehlt", MsgBoxStyle.OkOnly) Else Dim m_objADHook As AlibreX.AutomationHook m_objADHook = GetObject(, "AlibreX.AutomationHook") Dim m_objADRoot As IADRoot m_objADRoot = m_objADHook.Root Dim objADSession As AlibreX.IADSession ' Holds Session object 'Dim objADSession As AlibreX.IADSession ' Create a new Assembly using CreateEmptyAssembly() on Root object. objADSession = m_objADRoot.CreateEmptyAssembly("NewAssembly") ' Holds Assembly Session object Dim objADAssemblySession As AlibreX.IADAssemblySession ' Set Session as Assembly Session objADAssemblySession = objADSession ' Holds Root Occurrence Dim objADRootOccurrence As AlibreX.IADOccurrence ' Get Root Occurrence from Assembly Session objADRootOccurrence = objADAssemblySession.RootOccurrence() ' Holds Occurrences Dim objADOccurrences As AlibreX.IADOccurrences ' Get Occurrences collection from Root Occurance objADOccurrences = objADRootOccurrence.Occurrences() ' Holds Geometry Factory Dim objADGeometryFactory As AlibreX.IADGeometryFactory ' Get Geometry Factory from Session object objADGeometryFactory = objADSession.GeometryFactory Dim x As Integer Dim alpha As Double Dim X1norm As Double ' xyz Xx Startwert Dim X2norm As Double ' xyz Xy Startwert Dim Y1norm As Double ' xyz yx Startwert Dim Y2norm As Double ' xyz Yy Startwert '********************************** Progressbar definieren ************************* '********************************************************************************** For x = 0 To (Zaehler - 1) ' Alle Bauteile abfahren If bt(x).Layer = 1 Then ' Ist Bauteil auf Top X1norm = 1 ' X2norm = 0 ' Y1norm = 0 ' Y2norm = 1 ' ' RV(10) = 1 ' Z-Wert zuweisen alpha = bt(x).Rot * (Math.PI / 180) ' Alpha Winkel in Radiant alpha = alpha - (2 * alpha) ' Wert um 180° drehen RV(0) = Math.Round((Math.Cos(alpha) * X1norm + Math.Sin(alpha) * X2norm), 8) ' Drehmatrix RV(1) = Math.Round((-Math.Sin(alpha) * X1norm + Math.Cos(alpha) * X2norm), 8) ' Drehmatrix RV(4) = Math.Round((Math.Cos(alpha) * Y1norm + Math.Sin(alpha) * Y2norm), 8) ' Drehmatrix RV(5) = Math.Round((-Math.Sin(alpha) * Y1norm + Math.Cos(alpha) * Y2norm), 8) ' Drehmatrix RV(14) = 0 ' Z-Wert zuweisen End If ' Ende Bauteil Top If bt(x).Layer <> 1 Then ' Ist Bauteil Bottom X1norm = 1 ' Grundeinstellung Xx X2norm = 0 ' Grundeinstellung Xy Y1norm = 0 ' Grundeinstellung Yx Y2norm = -1 ' Grundeinstellung Yy RV(10) = -1 alpha = (180 + bt(x).Rot) * (Math.PI / 180) 'alpha = alpha - (2 * alpha) RV(0) = Math.Round((Math.Cos(alpha) * X1norm + Math.Sin(alpha) * X2norm), 8) RV(1) = Math.Round((-Math.Sin(alpha) * X1norm + Math.Cos(alpha) * X2norm), 8) RV(4) = Math.Round((Math.Cos(alpha) * Y1norm + Math.Sin(alpha) * Y2norm), 8) RV(5) = Math.Round((-Math.Sin(alpha) * Y1norm + Math.Cos(alpha) * Y2norm), 8) RV(14) = ((LP_Staerke - (LP_Staerke * 2)) / 10) End If 'MsgBox("" & RV(0) & " | " & RV(1) & " | " & RV(4) & " | " & RV(5) & " | " & RV(14)) ' Holds Transformation Array Data Dim adblTransformationArrayData(15) As Double ' Populate the Transformation Array with the following Data for Back View ' 1 0 0 0 ' 0 1 0 0 ' 0 0 1 0 ' 0 0 0 1 adblTransformationArrayData(0) = RV(0) adblTransformationArrayData(1) = RV(1) adblTransformationArrayData(2) = 0 adblTransformationArrayData(3) = 0 adblTransformationArrayData(4) = RV(4) adblTransformationArrayData(5) = RV(5) adblTransformationArrayData(6) = 0 adblTransformationArrayData(7) = 0 adblTransformationArrayData(8) = 0 adblTransformationArrayData(9) = 0 adblTransformationArrayData(10) = RV(10) adblTransformationArrayData(11) = 0 adblTransformationArrayData(12) = bt(x).PosX / 10 adblTransformationArrayData(13) = bt(x).PosY / 10 adblTransformationArrayData(14) = RV(14) adblTransformationArrayData(15) = 1 ' Holds Transformation Dim objADTransformation As AlibreX.IADTransformation ' Create Transformation objADTransformation = objADGeometryFactory.CreateTransform( _ adblTransformationArrayData) ' Holds File Path Dim strFilePath As String ' Set file path – Note: To be updated by the user strFilePath = bt(x).CadName Dim objKettlePart As AlibreX.IADDesignSession ' Open Kettle File objKettlePart = m_objADRoot.OpenFile(strFilePath) ' Holds Occurrence object Dim objADOccurrence As AlibreX.IADOccurrence ' Add an Empty Part as Occurrence objADOccurrence = objADOccurrences.Add( _ objKettlePart, objADTransformation) objKettlePart.close(False) If CheckBox1.Checked = True Then MsgBox("Warte, bis Partfile geschlossen ist") End If '************************************** Warteschleife *********************** Dim wait As Integer For wait = 0 To 1000 Next '**************************************************************************** 'ToolStripProgressBar1.Value = ToolStripProgressBar1.Value + ProgBar Next End If End Sub Private Sub TextBox4_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox4.TextChanged LP_Staerke = TextBox4.Text End Sub End Class