Microstation Vba Seçili elementleri cell oluşturma

Option Explicit

Function xy(x As Double, y As Double) As Point3d
    xy = Point3dFromXY(x, y)
End Function

Sub CreateOrphanCell()
    Dim eleCell As CellElement
    Dim vertices(0 To 3) As Point3d
    Dim ele(0 To 2) As Element
   
    Set ele(0) = CreateLineElement2(Nothing, xy(0, 5), xy(10, 5))
   
    vertices(0) = xy(0, 0)
    vertices(1) = xy(0, 7)
    vertices(2) = xy(10, 7)
    vertices(3) = xy(10, 0)
    Set ele(1) = CreateShapeElement1(Nothing, vertices, msdFillModeUseActive)
   
    Set ele(2) = CreateTextElement1(Nothing, "My Orphan Cell", xy(5, 6), Matrix3dIdentity)
   
    Set eleCell = CreateCellElement1(vbNullString, ele, xy(0, 0), False)
    eleCell.name = "OrphanCell"
    ActiveModelReference.AddElement eleCell
       
    eleCell.Redraw
End Sub

Sub secilileriCellYap()
  Dim ele() As Element
  Dim gElement As Element
  Dim eleCell As CellElement
  Dim oScanCriteria As ElementScanCriteria
  Dim oScanEnumerator As ElementEnumerator
  Dim eSay As Integer
  Dim aTags() As TagElement
  Dim tagIndex As Long
  If ActiveModelReference.AnyElementsSelected Then
     Set oScanEnumerator = ActiveModelReference.GetSelectedElements
  Else
     Dim sFence As Fence
     Set sFence = ActiveDesignFile.Fence
     If sFence.IsDefined Then Set oScanEnumerator = sFence.GetContents
  End If
  '     Set tElement = gElement.AsTextElement
  '     ActiveModelReference.AddElement tElement
  eSay = -1
  Do While oScanEnumerator.MoveNext
     Set gElement = oScanEnumerator.Current
     If gElement.IsGraphical Then
        eSay = eSay + 1
        ReDim Preserve ele(eSay)
        Set ele(eSay) = gElement
        aTags = gElement.GetTags
        For tagIndex = LBound(aTags) To UBound(aTags)
           Dim sourceTag As TagElement
           eSay = eSay + 1
           ReDim Preserve ele(eSay)
           Set sourceTag = aTags(tagIndex)
           Set ele(eSay) = sourceTag
           'ActiveDesignFile.Models(att).CopyElement sourceTag, oCC
        Next tagIndex
     End If
'     ActiveModelReference.RemoveElement gElement
   
  Loop
  Set eleCell = CreateCellElement1(vbNullString, ele, xy(0, 0), False)
  eleCell.name = "OrphanCell"
  ActiveModelReference.AddElement eleCell

End Sub

Kesim2019

DKTY KESİM MERKEZİ

2019 yılı

KNO	DURUM	KESIM SAAT	MASA SAAT	MASA NO	TESLIM SAAT

Kurban Kesim Takip Programı Excel

Kurban Kesim Takip Programı;
Büyükbaş kurban kesimi takibi için ecxelde oluşturulmuş bir programdır.

Hayr için kullanacaklara kullanım serbesttir.

Excelde Kesim takibi

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

Windows 64 olabilir.

32 bit office kurulduğundan emin isenizi  alttaki dosyaları indirip programı kullanabilirsiniz.

indirilen dosyaları c:\temp   içine kopyala (yoksa oluşturulur)

sağ tuş ile buraya çıkar denilir. ocx diye bir dizin oluşacak birde reg_kesim.bat dosyası olacak
reg_kesim.bat dosyası sağ tuş ile yönetici olarak çalıştırılır.

Yandaki gibi mesaj çıkması lazım

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

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

Bilgisayardan destek almak isteyenler olursa musait olursam Teamviewer ile  uzak masa üstü yardımı verebilirim.

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

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

Kesim takip Excel ve ocx dosyaları 2020 indir

rar lı dosyaların şifreleri videoda mevcuttur.

şifreleri görmek için youtube ekranında altyazıların açık olması lazım

Kurban Kesiminde canlı yayın

Kurban Satış Takip Programı 2019

Kurban Satış Takip Programı;
Büyükbaş kurban satışları için ecxelde oluşturulmuş bir programdır.

Excelde hisse satışı için kurbanlıklar veritabanına aktarıldıktan sonra
Ana Sayfa da Hisse Satışı ile yapılabilir.

Üst bölümde kurbanlıklar
Alt bölümde hissedarlar mevcuttur.

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

Excelde Hisse satışı,

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

Windows 64 olabilir.

32 bit office kurulduğundan emin iseniz eklenti dosyaları indirilip sisteme register edilmelidir.

kurbaneklenti.rar dosyası c:\temp   içine kopyala (yoksa oluşturulur)

sağ tuş ile buraya çıkar denilir. ocx diye bir dizin oluşacak birde reg_kurban.bat dosyası olacak
reg_kurban.bat dosyası sağ tuş ile yönetici olarak çalıştırılır.

Yandaki gibi mesaj çıkması lazım

kurbansatis2019.rar da excel ve veritabanı dosyaları mecut. onlarıda herhangi biryere çıkartalım.

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

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

Microstationda Parsel Bilgilerinin Excelden Yüklenmesi (Tags)

	Parsel_Tag.mvba programı Microstation VBA ile yazılmış bir programdır. Amacı kadastro parsellerine (Shape, Complex Shape ve Hole Element) Tag olarak bilgi yüklemektir. Parsel_Tag.mvba dosyasını indir. Öncelikle Microstationda Utilities-Macro-Project Manager da Parsel_Tag.mvba  dosyasını yükleyelim. Ayrıntıları videoda bulabilirsiniz.

Hasan Basri KARA Harita Mühendisi

Regedit İşlemi

Const HKEY_CLASSES_ROOT  = &H80000000
Const HKEY_CURRENT_USER  = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS         = &H80000003

strComputer = "."
strKeyPath = "Software\Test"

Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

DelSubkeysHKCU HKEY_CURRENT_USER, "Software\Bentley\Licensing\1.1\"
DelSubkeysHKLM HKEY_LOCAL_MACHINE, "Software\Wow6432Node\Bentley\Licensing\1.1\"

Sub DelSubkeysHKLM(HKEY_LOCAL_MACHINE, strKey)
    objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
    If IsArray(arrSubKeys) Then
        For Each strSubkey In arrSubKeys
            DelSubkeysHKLM HKEY_LOCAL_MACHINE, strKey & "\" & strSubkey
        Next
    End If
    objRegistry.DeleteKey HKEY_LOCAL_MACHINE, strKey
End Sub

Sub DelSubkeysHKCU(HKEY_CURRENT_USER, strKey)
    objRegistry.EnumKey HKEY_CURRENT_USER, strKey, arrSubKeys
    If IsArray(arrSubKeys) Then
        For Each strSubkey In arrSubKeys
            DelSubkeysHKCU HKEY_CURRENT_USER, strKey & "\" & strSubkey
        Next
    End If
    objRegistry.DeleteKey HKEY_CURRENT_USER, strKey
End Sub

Gizli Dosyaların Gösterilmesi

gdosyalar.reg diye dosya oluşturulup içine alttaki bilgiler yazılacak

Windows Registry Editor Version 5.00
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Advanced\Folder\Hidden]
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Advanced\Folder\Hidden]
"Text"="@shell32.dll,-30499"
"Type"="group"
"Bitmap"=hex(2):25,00,53,00,79,00,73,00,74,00,65,0 0,6d,00,52,00,6f,00,6f,00,74,\
00,25,00,5c,00,73,00,79,00,73,00,74,00,65,00,6d,00 ,33,00,32,00,5c,00,53,00,\
48,00,45,00,4c,00,4c,00,33,00,32,00,2e,00,64,00,6c ,00,6c,00,2c,00,34,00,00,\
00
"HelpID"="shell.hlp#51131"
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Advanced\Folder\Hidden\NOHIDDE N]
"RegPath"="Software\\Microsoft\\Windows\\CurrentVe rsion\\Explorer\\Advanced"
"Text"="@shell32.dll,-30501"
"Type"="radio"
"CheckedValue"=dword:00000002
"ValueName"="Hidden"
"DefaultValue"=dword:00000002
"HKeyRoot"=dword:80000001
"HelpID"="shell.hlp#51104"
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Advanced\Folder\Hidden\SHOWALL]
"RegPath"="Software\\Microsoft\\Windows\\CurrentVe rsion\\Explorer\\Advanced"
"Text"="@shell32.dll,-30500"
"Type"="radio"
"CheckedValue"=dword:00000001
"ValueName"="Hidden"
"DefaultValue"=dword:00000002
"HKeyRoot"=dword:80000001
"HelpID"="shell.hlp#51105"
[HKEY_CURRENT_USER\Software\microsoft\Windows\Curre ntVersion\Explorer\Advanced]
"Hidden"=dword:00000001

Klasör Seçenekleri Menüsü

Başlat /Çalıştır a Gpedit.msc yaz
Grup ilkesi penceresi açılacak
Kullanıcı yapılandırması /
       Yönetim şablonları /
            Windows bileşenleri /
                 Windows gezgini kısmına tıkladığında sağ taraftaki listede

"Klasör seçenekleri öğesini araçlar menüsünden kaldır" diye bi ayar var. ona sağ tıklayıp özelliklerden devre sışı yaparsan Klasör seçenekleri menüsü geri gelecektir.