Attribute VB_Name = "GetPoints"
'       This is a part of the source code for Pro/DESKTOP.
'       Copyright (C) 2000 Parametric Technology Corporation.
'       All rights reserved.

Option Explicit
Private pdApp As ProDESKTOP
Private excelApp As Object, theSheet As Object
Sub WritePointsToExcel()
    Dim pdApp As ProDESKTOP
    Set pdApp = CreateObject("ProDESKTOP.Application")
    
    Call InitializeExcel
    
    Dim doc As GraphicDocument
    Set doc = pdApp.GetActiveDoc
        If TypeOf doc Is PartDocument Then
                Dim des As aDesign
                Set des = doc.GetDesign
    
                Dim wp1 As aWorkplane
                Set wp1 = doc.GetActiveWorkplane
                Dim matrix As zMatrix
                Set matrix = wp1.GetTransformToPlane
                matrix.GetInverse
                
                Dim sk As aSketch
                Set sk = doc.GetActiveSketch
    
                Dim lineSet As ObjectSet
                Set lineSet = sk.GetLines(True, True)
                
                Dim numLines As Integer
                numLines = lineSet.GetCount
                
                'MsgBox "Sketch has " & lineSet.GetCount & " lines"
    
                Dim it As iterator
                Set it = pdApp.GetClass("It").CreateAObjectIt(lineSet)
    
                Dim theRow As Integer
                theRow = 1
                
                Dim startPt, endPt As aPoint
                Dim line As aLine
                Dim endvector As zVector
                Dim startvector As zVector
                Dim vec As zVector
                
                Set line = it.start
                Do While it.IsActive
                    Set startPt = line.GetStartPoint
                    Set endPt = line.GetEndPoint
                    
                    Set startvector = startPt.GetPosition
                    Set vec = matrix.MultiplyByVector(startvector)
                    Call PrintLine(theRow, vec.GetAt(0), vec.GetAt(1), vec.GetAt(2))
                    
                    Set endvector = endPt.GetPosition
                    Set vec = matrix.MultiplyByVector(endvector)
                    Call PrintLine(theRow, vec.GetAt(0), vec.GetAt(1), vec.GetAt(2))
                    
                    Set line = it.Next
                Loop
   End If
End Sub

Private Function InitializeExcel() As Boolean
    InitializeExcel = False
    
    On Error GoTo noExcel
    Set excelApp = CreateObject("Excel.Application")
    On Error GoTo 0
    
    With excelApp
        .Visible = True
        .WindowState = 2 ' wdWindowStateMinimize, 2 object for late binding
        .Workbooks.Add
    End With
    
    On Error GoTo noDoc
    Set theSheet = excelApp.ActiveSheet
    On Error GoTo 0

    InitializeExcel = True
    Exit Function

noExcel:
    MsgBox "Please install MS Excel"
    Exit Function
    
noDoc:
    MsgBox "Cannot create Excel document"
End Function

Private Sub PrintLine(theRow As Integer, x As Double, y As Double, z As Double)
    Dim theCol As Integer
        
    With excelApp
        theCol = .ActiveCell.Column
        .Cells(theRow, theCol).value = x
        .Cells(theRow, theCol + 1).value = y
        .Cells(theRow, theCol + 2).value = z
    End With

    theRow = theRow + 1

End Sub