netcad kod kaydetme txt

\' Bu makro Şaban GÜL Tarafından geliştirilen Netcad Makro GPT yapay zeka modeli ile üretilmiştir.
\' Daha fazla bilgi için www.sabangul.com adresine veya sabangul67@gmail.com adresine gidiniz.
\' Makro Adı: sabangul_Objeleri_Proje_Bilgi_Aktarici_OtoKayitSecimli
\' Açıklama: Netcad çiziminde seçilen objelerin ve projenin tüm detaylı bilgilerini bir TXT dosyasına aktarır. Proje genel bilgileri erişimi, tabaka adı alma formatı (Netcad.NcLayerManager.Layer(index).Name), yazılarda koordinatlar ve alan objelerinde GetObjectAsPline ile doğru obje tanıtımı ve köşe noktaları (obj.cor(l).x/y) eklenmiştir. Dosya kaydetme yolu, standart Windows \"Farklı Kaydet\" iletişim kutusu ile kullanıcıdan alınır.
\' Anahtar Kelimeler: Netcad makro, proje bilgileri, obje bilgileri, VBScript, TXT rapor, çizim envanteri, otomatik raporlama, harita analizi, geometri bilgisi, GIS veri aktarımı, Netcad otomasyon, alan bilgisi, uzunluk bilgisi, nokta koordinatları, yazı koordinatları, poligon köşe noktaları, Şaban Gül makro, Netcad VBS, obje sorgulama, detaylı bilgi aktarımı, veri yönetimi, Netcad proje, oto kayıt, CommonDialog.

Sub Main

    Dim sabangul_secimkumesi
    Dim sabangul_obj
    Dim sabangul_polyline_obj \' Poligon objesi için özel değişken
    Dim sabangul_fs
    Dim sabangul_ts
    Dim sabangul_dosya_yolu
    Dim sabangul_common_dialog \' Ortak iletişim kutusu nesnesi
    Dim sabangul_proje_adi
    Dim sabangul_proje_yolu
    Dim sabangul_current_date
    Dim sabangul_current_time
    Dim sabangul_tabaka_adi \' Tabaka adı için değişken
    Dim sabangul_active_document \' Aktif doküman nesnesi
    Dim sabangul_layer_manager \' NcLayerManager nesnesi

    Set sabangul_fs = CreateObject(\"Scripting.FileSystemObject\")
    
    \' Ortak iletişim kutusu nesnesini oluştur
    On Error Resume Next \' Hata oluşursa devam et
    Set sabangul_common_dialog = CreateObject(\"MSComDlg.CommonDialog\")
    If Err.Number <> 0 Then
        MsgBox \"MSComDlg.CommonDialog nesnesi oluşturulamadı. Makro devam edemez.\" & vbCrLf & \"Hata: \" & Err.Description, vbCritical, \"Hata [sabangul.com]\"
        Exit Sub
    End If
    On Error GoTo 0 \' Hata yakalamayı kapat


    
    sabangul_current_date = Date
    sabangul_current_time = Time

    With sabangul_common_dialog
        .DialogTitle = \"Rapor Kaydedilecek Dosya Seçimi [sabangul.com]\"
        .Filter = \"Metin Dosyaları (*.txt)|*.txt|Tüm Dosyalar (*.*)|*.*\"
        .FilterIndex = 1
        .MaxFileSize = 260
        .FileName = \"Objeler_Proje_Bilgi_Raporu.txt\"
        .InitDir = \"C:\\Kamupratik\\BEYANNAME\\\" \' Varsayılan başlangıç dizini
        .Flags = cdlOFNOverwritePrompt Or cdlOFNPathMustExist Or cdlOFNExplorer \' cdlOFNExplorer bayrağı Netcad içinde çalışırken sorun çıkarabilir, gerekirse kaldırılabilir.
        
        \' Farklı Kaydet iletişim kutusunu göster
        .ShowSave
        
        If .FileName <> \"\" Then
            sabangul_dosya_yolu = .FileName
        Else
            MsgBox \"Dosya seçimi iptal edildi. İşlem iptal edildi.\", vbCritical, \"İşlem İptali [sabangul.com]\"
            Exit Sub
        End If
    End With

    \' Klasör yoksa oluştur (CommonDialog ile seçildiğinde genellikle gerekli olmaz ama yine de bir önlem)
    If Not sabangul_fs.FolderExists(sabangul_fs.GetParentFolderName(sabangul_dosya_yolu)) Then
        On Error Resume Next \' Hata oluşursa devam et
        sabangul_fs.CreateFolder sabangul_fs.GetParentFolderName(sabangul_dosya_yolu)
        If Err.Number <> 0 Then
            MsgBox \"Klasör oluşturulamadı: \" & sabangul_fs.GetParentFolderName(sabangul_dosya_yolu) & vbCrLf & \"Hata: \" & Err.Description, vbCritical, \"Hata [sabangul.com]\"
            Exit Sub
        End If
        On Error GoTo 0 \' Hata yakalamayı kapat
    End If
    
    \' Dosyayı oluştur veya üzerine yaz
    Set sabangul_ts = sabangul_fs.CreateTextFile(sabangul_dosya_yolu, True)

    With Netcad
        \' NcLayerManager nesnesini al
        Set sabangul_layer_manager = NcLayerManager

        \' Proje Genel Bilgileri
        sabangul_ts.WriteLine \"--- Netcad Proje ve Seçili Objeler Bilgi Raporu ---\"
        sabangul_ts.WriteLine \"Rapor Oluşturulma Tarihi: \" & sabangul_current_date & \" \" & sabangul_current_time
        sabangul_ts.WriteLine \"--------------------------------------------------\"
        sabangul_ts.WriteLine \"Açık Proje Adı: \" & sabangul_proje_adi
        sabangul_ts.WriteLine \"Açık Proje Yolu: \" & sabangul_proje_yolu
        sabangul_ts.WriteLine \"--------------------------------------------------\"
        sabangul_ts.WriteLine \"\"

        Set sabangul_secimkumesi = .NewSelectionSet

        If sabangul_secimkumesi.Select(\"Bilgileri alınacak objeleri seçiniz. Seçimi bitirmek için sağ tıklayın.\", _
                                        Array(ncObjTypePolyline, ncObjTypeLine, ncObjTypePoint, ncObjTypeText, ncObjTypeCircle, ncObjTypeShape, ncObjTypeArc, ncObjTypeSpiral, ncObjTypeIsohdr, ncObjTypeRectangle, ncObjTypePafta)) Then

            For sabangul_i = 0 To sabangul_secimkumesi.NE - 1
                Set sabangul_obj = .NewObject
                sabangul_j = sabangul_secimkumesi.GetSelectedObject(sabangul_i, sabangul_obj)

                \' Tüm objeler için tabaka bilgisi
      
                    sabangul_tabaka_adi = sabangul_layer_manager.Layer(sabangul_obj.tabaka).Name
               

                sabangul_ts.WriteLine \"Objelerin Index Numarası: \" & sabangul_j
                sabangul_ts.WriteLine \"Objenin Tabakası: \" & sabangul_tabaka_adi
                sabangul_ts.WriteLine \"Objenin GIS Sınıfı (ncObjType): \" & sabangul_obj.cls \' Objenin sayısal sınıf değeri
                sabangul_ts.WriteLine \"Objenin GIS Kodu: \" & sabangul_obj.objname
                sabangul_ts.WriteLine \"Objenin Renk Kodu: \" & sabangul_obj.renk
                
                \' Obje türüne göre detaylı bilgi aktarımı
                Select Case sabangul_obj.cls
                    Case ncObjTypePolyline \' Çoklu Doğru (Alan)
                        \' Objenin poligon olarak tanıtılması
                        Set sabangul_polyline_obj = sabangul_obj.GetObjectAsPline()

                        sabangul_ts.WriteLine \"Obje Türü: Çoklu Doğru (Alan)\"
                        sabangul_ts.WriteLine \"Adı: \" & sabangul_obj.pname \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        sabangul_ts.WriteLine \"Kalınlık: \" & sabangul_obj.w \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        sabangul_ts.WriteLine \"Çizgi Tipi: \" & sabangul_obj.lt \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        sabangul_ts.WriteLine \"Çevresi: \" & FormatNumber(sabangul_obj.length(0), 3) \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        sabangul_ts.WriteLine \"Tapu Alanı: \" & FormatNumber(sabangul_obj.tarea, 3) \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        sabangul_ts.WriteLine \"Hesap Alanı: \" & FormatNumber(sabangul_obj.area, 3) \' sabangul_obj yerine sabangul_polyline_obj kullanıldı
                        
                        \' Alan objesi köşe noktaları (obj.cor(l).x/y formatı)
                        sabangul_ts.WriteLine \"Köşe Noktaları (\" & sabangul_polyline_obj.num & \" Adet):\"
                        For sabangul_k = 0 To sabangul_polyline_obj.num - 1 \' .num kullanıldı
                            \' Noktaya doğrudan .cor(l).x ve .cor(l).y ile erişim
                            sabangul_ts.WriteLine \"  Nokta \" & (sabangul_k + 1) & \": X=\" & FormatNumber(sabangul_polyline_obj.cor(sabangul_k).x, 3) & \", Y=\" & FormatNumber(sabangul_polyline_obj.cor(sabangul_k).y, 3)
                        Next
                        Set sabangul_polyline_obj = Nothing \' Temizleme

                    Case ncObjTypeLine \' Doğru (Çizgi)
                        sabangul_ts.WriteLine \"Obje Türü: Doğru (Çizgi)\"
                        sabangul_ts.WriteLine \"Adı: \" & sabangul_obj.pname
                        sabangul_ts.WriteLine \"Kalınlık: \" & sabangul_obj.w
                        sabangul_ts.WriteLine \"Çizgi Tipi: \" & sabangul_obj.lt
                        sabangul_ts.WriteLine \"Uzunluğu: \" & FormatNumber(sabangul_obj.length(0), 3)

                    Case ncObjTypePoint \' Nokta
                        sabangul_ts.WriteLine \"Obje Türü: Nokta\"
                        sabangul_ts.WriteLine \"Adı: \" & sabangul_obj.pname
                        sabangul_ts.WriteLine \"Nokta Kodu: \" & sabangul_obj.pcode
                        sabangul_ts.WriteLine \"X Koordinatı: \" & FormatNumber(sabangul_obj.x, 3)
                        sabangul_ts.WriteLine \"Y Koordinatı: \" & FormatNumber(sabangul_obj.y, 3)
                        sabangul_ts.WriteLine \"Z Koordinatı: \" & FormatNumber(sabangul_obj.z, 3)

                    Case ncObjTypeText \' Yazı
                        sabangul_ts.WriteLine \"Obje Türü: Yazı\"
                        sabangul_ts.WriteLine \"Yazı Metni: \" & sabangul_obj.s
                        sabangul_ts.WriteLine \"X Koordinatı: \" & FormatNumber(sabangul_obj.x, 3)
                        sabangul_ts.WriteLine \"Y Koordinatı: \" & FormatNumber(sabangul_obj.y, 3)
                        sabangul_ts.WriteLine \"Açı (Grad): \" & FormatNumber(sabangul_obj.angle, 3)
                        sabangul_ts.WriteLine \"Genişlik Çarpanı: \" & FormatNumber(sabangul_obj.wsc, 3)
                        sabangul_ts.WriteLine \"Yazı Boyu: \" & FormatNumber(sabangul_obj.sc, 3)
                        sabangul_ts.WriteLine \"Dayanma: \" & sabangul_obj.just
                        sabangul_ts.WriteLine \"Özellikler: \" & sabangul_obj.flags

                    Case ncObjTypeCircle \' Daire (Çember)
                        sabangul_ts.WriteLine \"Obje Türü: Daire (Çember)\"
                        sabangul_ts.WriteLine \"Merkez X: \" & FormatNumber(sabangul_obj.x, 3)
                        sabangul_ts.WriteLine \"Merkez Y: \" & FormatNumber(sabangul_obj.y, 3)
                        sabangul_ts.WriteLine \"Merkez Z: \" & FormatNumber(sabangul_obj.z, 3)
                        sabangul_ts.WriteLine \"Yarıçap: \" & FormatNumber(sabangul_obj.r, 3)
                        sabangul_ts.WriteLine \"Alan: \" & FormatNumber((3.1415926535 * sabangul_obj.r * sabangul_obj.r), 3) \' Yaklaşık Pi

                    Case ncObjTypeShape \' Sembol
                        sabangul_ts.WriteLine \"Obje Türü: Sembol\"
                        sabangul_ts.WriteLine \"Adı: \" & sabangul_obj.pname
                        sabangul_ts.WriteLine \"X Koordinatı: \" & FormatNumber(sabangul_obj.x, 3)
                        sabangul_ts.WriteLine \"Y Koordinatı: \" & FormatNumber(sabangul_obj.y, 3)
                        sabangul_ts.WriteLine \"Z Koordinatı: \" & FormatNumber(sabangul_obj.z, 3)
                        \' Diğer sembol özellikleri eklenebilir (örn: ölçek, açı)

                    Case ncObjTypeArc \' Yay
                        sabangul_ts.WriteLine \"Obje Türü: Yay\"
                        sabangul_ts.WriteLine \"Merkez X: \" & FormatNumber(sabangul_obj.x, 3)
                        sabangul_ts.WriteLine \"Merkez Y: \" & FormatNumber(sabangul_obj.y, 3)
                        sabangul_ts.WriteLine \"Merkez Z: \" & FormatNumber(sabangul_obj.z, 3)
                        sabangul_ts.WriteLine \"Yarıçap: \" & FormatNumber(sabangul_obj.r, 3)
                        sabangul_ts.WriteLine \"Başlangıç Açısı (Grad): \" & FormatNumber(sabangul_obj.startangle, 3)
                        sabangul_ts.WriteLine \"Bitiş Açısı (Grad): \" & FormatNumber(sabangul_obj.endangle, 3)

                    Case ncObjTypeSpiral \' Spiral
                        sabangul_ts.WriteLine \"Obje Türü: Spiral\"
                        \' Spiral objelerin detaylı özelliklerini buraya ekleyebilirsiniz.
                        \' Netcad dokümantasyonundan veya tecrübelerinizden faydalanarak uygun özellikler eklenebilir.

                    Case ncObjTypeIsohdr \' İzohips Eğrileri
                        sabangul_ts.WriteLine \"Obje Türü: İzohips Eğrisi\"
                        \' İzohips objelerin detaylı özelliklerini buraya ekleyebilirsiniz.

                    Case ncObjTypeRectangle \' Kutu
                        sabangul_ts.WriteLine \"Obje Türü: Kutu\"
                        sabangul_ts.WriteLine \"Min X: \" & FormatNumber(sabangul_obj.xmin, 3)
                        sabangul_ts.WriteLine \"Min Y: \" & FormatNumber(sabangul_obj.ymin, 3)
                        sabangul_ts.WriteLine \"Max X: \" & FormatNumber(sabangul_obj.xmax, 3)
                        sabangul_ts.WriteLine \"Max Y: \" & FormatNumber(sabangul_obj.ymax, 3)
                        sabangul_ts.WriteLine \"Genişlik: \" & FormatNumber((sabangul_obj.xmax - sabangul_obj.xmin), 3)
                        sabangul_ts.WriteLine \"Yükseklik: \" & FormatNumber((sabangul_obj.ymax - sabangul_obj.ymin), 3)
                        sabangul_ts.WriteLine \"Alan: \" & FormatNumber((sabangul_obj.xmax - sabangul_obj.xmin) * (sabangul_obj.ymax - sabangul_obj.ymin), 3)

                    Case ncObjTypePafta \' Pafta
                        sabangul_ts.WriteLine \"Obje Türü: Pafta\"
                        \' Pafta objelerin detaylı özelliklerini buraya ekleyebilirsiniz.

                    Case Else
                        sabangul_ts.WriteLine \"Obje Türü: Bilinmiyor veya Desteklenmiyor (\" & sabangul_obj.cls & \")\"
                End Select
                sabangul_ts.WriteLine \"---------------------------------------\"
                sabangul_ts.WriteLine \"\"
            Next
            MsgBox \"İşlem Tamamlandı! Rapor \'\" & sabangul_dosya_yolu & \"\' adresine kaydedildi.\", vbInformation, \"Başarılı [sabangul.com]\"
        Else
            MsgBox \"Hiçbir obje seçilmedi. İşlem iptal edildi.\", vbExclamation, \"Seçim Yok [sabangul.com]\"
        End If

         
        Set sabangul_secimkumesi = Nothing
        Set sabangul_obj = Nothing
    End With

    sabangul_ts.Close
    Set sabangul_ts = Nothing
    Set sabangul_fs = Nothing
    Set sabangul_common_dialog = Nothing \' Temizleme eklendi
    Set sabangul_active_document = Nothing
    Set sabangul_layer_manager = Nothing
    Set sabangul_polyline_obj = Nothing \' Eklenen poligon objesi için temizleme

End Sub