- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
i have a code which exports workpoints to an excel file. I need the coordinates of the workpoints to create a sweeping of a pipe. the code exports the workpoints and the zeropoint (0,0,0). This zeropoint is not a point of the pipe. - only the 4 workpoints.
Is it possible to change the code that i can choose a workpoint? This workpoint shouldt be the new startpoint (0,0,0) for the sweeping. The code shouldt be take the coordinates of this choosen workpoint and calculate the new coordinates for all the other 4 points (not for the original zeropint).
For example, if i choose the Point -100,-300,100 the Excel file shouldt Looks like this:
This is my code:
Sub ExportArbeitspunkte()
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oDef As PartComponentDefinition
Set oDef = oDoc.ComponentDefinition
Dim oWorkpoints As WorkPoints
Dim oWP As WorkPoint
Dim oP As Point
'get all workpoints in this part
Set oWorkpoints = oDef.WorkPoints
'Create a new Excel instance
Dim oExcelApplication As Excel.Application
Set oExcelApplication = New Excel.Application
'create a new excel workbook
Dim oBook As Excel.Workbook
Set oBook = oExcelApplication.Workbooks.Add()
Dim oSheet As Excel.WorkSheet
Set oSheet = oBook.ActiveSheet
Dim nRow As Integer
nRow = 1
'write the coordinates into separate columns, one workpoint each row
For Each oWP In oWorkpoints
Set oP = oWP.Point
oSheet.Cells(nRow, 1) = oP.X * 10
oSheet.Cells(nRow, 2) = oP.Y * 10
oSheet.Cells(nRow, 3) = oP.Z * 10
nRow = nRow + 1
Next
Dim OutputFile As String
OutputFile = Left(ThisApplication.ActiveDocument.FullFileName, _
Len(ThisApplication.ActiveDocument.FullFileName) - 4) + "_Arbeitspunkte.xls"
On Error Resume Next
oBook.SaveAs (OutputFile)
oBook.Close
Set oBook = Nothing
Set oSheet = Nothing
Set oExcelApplication = Nothing
MsgBox "Es wurde eine Excel Tabelle im aktuellen Verzeichnis erstellt und eine neue IPT für den Import geöffnet!"
'Make a new part file
Dim oPartDoc As PartDocument
'Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, "V:\Inventor-2015\1-Inventor\TEMPLATES\_VORLAGE ROHR.ipt")
End Sub
Thank you in advance for your help.
Regards from germany
Martin
Solved! Go to Solution.