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

Excel ile Kurban Satış Takibi

Kurban Satış Takip Programı;

Büyükbaş kurban satışları için kullanılabilecek Excelde oluşturulmuş bir programdır.

Excelde,

Ana Sayfa

Kişiler

Kurbanlıklar

Sayfaları bulunmaktadır. Kurbanlıklar sayfasında kurban bilgileri girilir.

Kişiler sayfasında Hisse Satışı düğmesi ile program calıştırılır.

Programın calışması icin Office - Excelin 32 bit olması gerekir. 

Windows 64 olabilir.

32 bit office kurulduğundan emin iseniz  MSCOMCTL.OCX dosyası indirilip sisteme register edilmelidir.

MSCOMCTL.OCX dosyası

 32 bit Windows ta

 c:\windows\system32 ye kopyalanır

calıştır komutuna

regsvr32 c:\windows\system32\mscomctl.ocx

yazılarak register edilir.

64 bit windows ta

c:\windows\syswow64 dizinine kopyalanır

calıştır komutuna veya command (cmd) satırına

regsvr32 c:\windows\syswow64\mscomctl.ocx

yazılarak register edilir.

Acılışta Güvenlik Uyarısı olarak Macrolar devre dışı bırakıldı diyor ise Seceneklerden icerik etkinleştirilir.

Register edilince alttaki uyarı alınacaktır.

Yardım almak isteyenler telden bana ulaşabilirler. Dosyanın Ana Sayfasında telefon numaram mevcut.

Bilgisayardan destek almak isteyenler alttaki programı (Teamviewer Portable versyonu) indirip (rar) lı dosyayı biryere acıp Teamviewer.exe yi calıştırarak  uzak masa üstü yardımı verebilirim.

---------------------------------------------------------------------------------------

Excel dosyasını  indir

Kesim takip flash dosyası drive dan indir

Kesim takip flash dosyası EXE indir
Kesim takip flash dosyası SWF indir
SWF dosyasının çalışması için FlashPlayer indir

---------------------------------------------------------------------------------------

Uzaktan Yardım Programı indir

Kurban Kesiminde canlı yayın

Kurban – Ana Sayfa

DKTY KESİM MERKEZİ

2020 yılı

KNO	DURUM	KESIM SAAT	MASA SAAT	MASA NO	TESLIM SAAT