Sondaj Noktası Litolojisi

Nokta bilgileri Excel sayfası	Sondaj noktasına ait bilgilerin Microstationa silindir şeklinde çizilmesi. Sondaj noktasının koordinatları 0,0,0, olarak ele alınacak, boru yarıçapı 10 m default olarak kullanılacak. Eklemeler Y yönünde olacak. Öncelikle Microstationda Utilities-Macro-Project Manager Penceresini açalım ve silindir adında yeni bir mvba dosyası oluşturalım.

İçine Kodlarımızı yazalım:

Sub Silindir()

   Dim pointS As Point3d

   Dim pointE As Point3d

   Dim cap As Double

   Dim oPipe  As Element

   Dim levname As String

   

   cap = 10

   Set oXL = GetObject(, "Excel.Application")

   Set oSheet = oXL.activeWorkbook.activesheet

   

   k = 2

   Do While oSheet.cells(k, 1) <> ""

      pointS.X = 0

      pointS.Y = -oSheet.cells(k, 2)

      pointS.Z = 0

   

      pointE.X = 0

      pointE.Y = -oSheet.cells(k, 3)

      pointE.Z = 0

      

      levname = oSheet.cells(k, 4)

      

      Set oPipe = SilindirCiz(pointS, pointE, cap, msdDrawingModeNormal)

      oPipe.Level = myLevel(levname)

      ActiveModelReference.AddElement oPipe

      k = k + 1

   Loop

End Sub

Private Function SilindirCiz(ByRef startPoint As Point3d, ByRef endPoint As Point3d, ByVal radius As Double, ByVal drawMode As MsdDrawingMode) As Element

    Set SilindirCiz = Nothing

    Dim oCone As ConeElement

    Set oCone = CreateConeElement1(Nothing, radius, startPoint, radius, endPoint, Matrix3dIdentity)

    oCone.Redraw drawMode

    Set SilindirCiz = oCone

End Function

Private Function myLevel(levname As String) As Level

   Set myLevel = ActiveDesignFile.Levels.Find(levname)

   If myLevel Is Nothing Then

      CadInputQueue.SendKeyin "level create " & Chr(34) & levname & Chr(34)

      Set myLevel = ActiveDesignFile.Levels.Find(levname)

   End If

End Function

Bu örnek dahada geliştirilebilir. Örneğin 5 sütuna renk bilgisi eklenip oPipe.Color = oSheet.cells(k, 5) dediğimizde rengide excelden alınabilir.

Programı çalıştırmak için Key-in komut satırına vba run Silindir  dememiz yeterli.

  Çalışması için çalışma sayfası 3D, Excel dosyasının açık olması ve nokta bilgilerinin sayfası aktif olmalıdır.

silindir.mvba