10 Kasım 2016 Perşembe

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 Point3dByRef endPoint As Point3dByVal radius As DoubleByVal drawMode As MsdDrawingModeAs 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

Hiç yorum yok:

Yorum Gönder