Autocad VBA uygulamaları: 2. Basit metraj

Merhabalar!

Bugün metraj yaparken kullanılabilecek, bir mahale ait polyline tıklandığında bu polyline ın alan ve çevresini bir text dosyasına tabseperated biçiminde ihrac eden kodu paylaşıyorum. Tabiki bu kod çok daha geliştirilebilir. Örneğin kullanıcıdan mahal adı girmek yerine bir text nesnesinden yada attribute nesnesinden mahal adı alınabilir. Oluşturulan text dosyasının tabseperated olması, Excel gibi programlara ithal edilirken, kolonların sorunsuz bir şekilde tanınması için çok kullanışlıdır.

Dikkat edilmesi gereken, seçilecek polyline ların "closed" özelliğinde olması ve tabiki de polyline olması :)

Kullanıcıdan alınan bilgiler, C: sürücüsünde data isimli klasördeki (bu klasörün daha önceden oluşturulmuş olması gerekli) METRAJTABLO.txt isimli dosyaya yazılır. Bu dosyaya APPEND yani alt alta eklenerek data girilir. Eğer baştan başlamak istenirse bu dosya açılıp içeriği elle temizlenmelidir. Tabiki dosya adı ve yolu istenildiği şekilde düzenlenebilir. Nitekim bazı işletim sistemleri C: sürücüsünü yazmaya karşı koruyabilmektedir. Bu nedenle yazma hakkına sahip olduğunuz bir klasör adı girmenizi tavsiye ediyorum. Mesela masaüstünde bir klasörün tam yolu gibi.


Sub basitMetraj()

Dim mahaladi As String
Dim pl As AcadEntity
Dim alan As Double
Dim strng As String
Dim cevre As Double

mahaladi = ThisDrawing.Utility.GetString(True, "MAHAL ADINI GIRINIZ...")
ThisDrawing.Utility.GetEntity pl, f, "POLYLINE SECINIZ..."
alan = FormatNumber(pl.Area / 10000, 3, vbFalse, vbFalse, vbFalse)
cevre = FormatNumber(pl.Length, 3, vbFalse, vbFalse, vbFalse)
strng = mahaladi & vbTab & CStr(alan) & vbTab & cevre

WTF strng

End Sub
Function WTF(yazilacak As String)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Dim path As String
Dim yaz As String

yaz = CStr(yazilacak)
path = "C:\data\METRAJTABLO.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(path, ForAppending, True, -1)
f.writeline (yaz)
f.Close
End Function

herkese kolay gelsin...

Autocad VBA uygulamaları: 1. Kot yaz

VBA desteği, özellikle tekrarı olan işlemlerin yapıldığı uygulamalarda bazen çok kısa zamanda kısa bir kod yazılarak işlerin kolaylaştırılmasını, güvenilir çözüm üretilmesini ve proje çizim sürecinin hızlanmasını sağlamaktadır.

Ekran görüntüsü

Bu örnekte, ekteki kısa dvb kodu çalıştırıldığında, bir bina cephesine kot yazdırmak için önce temel nokta yani sıfır kotu tıklanarak programa başlangıç kotu aktarılır. Daha sonra bu noktanın üstü yada altında tıklanan her noktaya, kot işareti ve tıklanan noktanın referanstan uzaklığına bağlı olarak (yalnızca y yönü) kotu yazdırılır.





Program kodu:

Sub kotyaz()
Dim kot As Variant
Dim yer As Variant
Dim fark As String
Dim arti As String
Dim temp As AcadMText
Dim yazi As String
Dim base As Variant
Dim rowstart As Integer

On Error Resume Next

    With ThisDrawing.Utility
    rowstart = .GetString(True, vbCr & "Kaç adet kot yazmak istiyorsunuz?...")
    End With
   
rowstart = CInt(rowstart)
base = Utility.GetPoint(, "Sýfýr kotunu gösteriniz...")
Set blok = ThisDrawing.ModelSpace.InsertBlock(base, "kotblok", 1, 1, 1, 0)
yer = base
yer(0) = base(0) - 44
yer(1) = base(1) + 25
arti = "±"
yazi = "±" & "0.00"
Set temp = ThisDrawing.ModelSpace.AddMText(yer, 40, yazi)

For i = 1 To rowstart
kot = Utility.GetPoint(base, "Kot verilecek nokta...")
fark = (kot(1) - base(1)) / 100
fark = FormatNumber(fark, 2, vbTrue, vbFalse, vbFalse)

    Set blok = ThisDrawing.ModelSpace.InsertBlock(kot, "kotblok", 1, 1, 1, 0)
    yer(0) = kot(0) - 44
    yer(1) = kot(1) + 25

    If fark >= 0 Then
        arti = "+"
        yazi = "+" & fark
        Set temp = ThisDrawing.ModelSpace.AddMText(yer, 40, yazi)
    Else
        fark = Abs(fark)
        arti = "-"
        yazi = "-" & fark
        Set temp = ThisDrawing.ModelSpace.AddMText(yer, 40, yazi)
    End If
   
Next i

End Sub

 Kodun çalışması için çizimde "kotblok" adında bir block nesnesi tanımlı olmalıdır. Aşağıdaki örnek merdiven çizimi açılıp, kod test edilebilir. Bunun için çizim açılıp "vbaide" komutu verilir. Açılan pendere Visual Basic editör penceresidir. Buraya kod yapıştırılıp çalıştırıldığında komut satırından yönergeler izlenerek çizim tamamlanır.
 Dwg dosyası indir

 ilerde yine görüşmek dileklerimle...