Export Coordinates to MicroStation from Excel

You must already start MicroStation before you press the button at the Excel Sheet.

Here is the VBA-code

Sub Koordinater_till_dgn()
   
    '© 2009-03-24 Lars-Erik Svensson
    ' Macro som skriver koordinater till dgn sammanbinder med smartline

    Dim myMSAppCon As MicroStationDGN.ApplicationObjectConnector
    Dim myMSApp As MicroStationDGN.Application

    Set myMSAppCon = GetObject(, "MicroStationDGN.ApplicationObjectConnector")
    Set myMSApp = myMSAppCon.Application


    Dim mydgn As DesignFile
    Dim myModel As ModelReference
   
    Set mydgn = myMSApp.ActiveDesignFile
    Set myModel = myMSApp.ActiveModelReference

    myMSApp.Visible = True

'---------------------------------------------------------------------
' Variabler för Excel
 '   Dim myExcel As Excel.Application
 '   Dim mySheetA As Worksheet
   
' Kopplar upp Excel och väljer INData-bladet
 '   Set myExcel = GetObject(, "Excel.Application")
  ' Set mySheetA = myExcel.ActiveWorkbook.Worksheets("Koordinater")
   
' Variabler för Koordinater
    Dim n As Integer
    Dim r As Integer
    Dim Rad As Integer
    Dim AntPkt As Variant
    Dim Pktnr As String
    Dim Xkord As Variant
    Dim Ykord As Variant
    Dim Zkord As Variant
    Dim Antp As Integer
   
'Hitta radnumret för sista använda cellen i kolumnen
    r = Worksheets("Koordinater").Cells(65536, "A").End(xlUp).Row
 
' Antal punkter
    Antp = r - 2
 
   'Debug.Print r
' Sätter värdet på n till 0
    n = 0
 
' Variabler för MicroStation
    Dim MYline As LineElement
    Dim myText As TextElement
    Dim TextPkt As Point3d
    Dim rotMatrix As Matrix3d
   
' Variabel som sätter för flera punkter
    Dim MinaPkt() As Point3d
   
' Här sätts det hur många punkter den skall rita To
    ReDim MinaPkt(0 To (Antp))
   
' Hämtar in antal punkter från Excel
    For Each AntPkt In Worksheets("Koordinater").Range("A2:A" & r)

        Rad = AntPkt.Row
       'Hämtar indata från Excel
        Pktnr = Worksheets("Koordinater").Range("A" & Rad)
        Xkord = Worksheets("Koordinater").Range("B" & Rad)
        Ykord = Worksheets("Koordinater").Range("C" & Rad)
        Zkord = Worksheets("Koordinater").Range("D" & Rad)
       
       ' Sätter i koordinater för linjen och uppdaterar antal n
        MinaPkt(n).X = Xkord
        MinaPkt(n).Y = Ykord
        MinaPkt(n).Z = Zkord
       
       ' Sätter in koordinater för texten.
        TextPkt.X = Xkord
        TextPkt.Y = Ykord
        TextPkt.Z = Zkord
       
        'Set myText = CreateTextElement1(Nothing, "Pkt" & n + 1, TextPkt, rotMatrix)
        Set myText = CreateTextElement1(Nothing, Pktnr, TextPkt, rotMatrix)
        ActiveModelReference.AddElement myText
   
      ' Debug.Print Pktnr; vbTab; Xkord; vbTab; Ykord; vbTab; Zkord

      'Stegar upp n med ett steg för varje punkt
        n = n + 1
    Next
   
    Set MYline = CreateLineElement1(Nothing, MinaPkt)
    ActiveModelReference.AddElement MYline
   
   'Skriver till inforaderna i MicroStation
    ShowCommand "© LES: VBA "
    ShowPrompt "Koodinater till MicroStation från Excel, Skapat från Excel"
    ShowStatus "Linjen är nu uppritad "
   
'---------------------------------------------------------------------
Set myMSApp = Nothing
Set myMSAppCon = Nothing

End Sub

Anonymous
Related
Recommended