Etiketler

AutoCAD (63) bedava (49) Dosya (35) Resim (33) program (21) Ziyaretçi Defteri (20) excel (18) Eğitim (17) Güncelleme (17) Nasıl yapılır (16) asgbookphp (16) VBA (15) Şablon (15) Qbasic (14) php (14) online (13) Fotoğraf (12) Freeware (12) PHP script (12) Visual Basic (12) Kaynak kod (11) Dos (10) SolidWorks (10) ürünler (9) E-book (8) Photoshop (8) tutorial (6) Ders (5) Lisp (5) Word (5) Programlama (4)

Youtube Kanalıma Abone Olunuz

18 Haziran 2019 Salı

AutoCAD ile VBA Makro kullanımı #4-1

Yazının önceki bölümü: AutoCAD ile VBA makro kullanımı #3

Bu bölümü iki ayrı sayfa olarak hazırladım.
Bir önceki yazımda kullandığım eksen çizen VBA kodları geliştireceğim.
Eski kodlarda yapacağım iyileştirmelerde şunlar olacak
  • Eksen için daire veya yay seçilebilecek
  • Farklı nesne seçildiyse çizim yapılmayıp mesaj ile çıkılacak
  • Eksen katmanı yoksa eksen katmanı eklenecek
  • Katman ayarları yapılacak
  • Aktif katman "Eksen" olacak
  • "Eksen" katmanına eksen çizgileri çizilecek
  • Bir önceki katman, aktif katman olacak


Sub EksenCiz()
'AutoCAD ile VBA Makro kullanımı #4
'Autocad VBA ile Daire ya da yaylara eksen çizme:

' Kodların kullanımı ile ilgili video:
' https://www.youtube.com/watch?v=nph7BM3kQbQ

' AutoCAD ile VBA Makro kullanımı playlist:
' https://www.youtube.com/playlist?list=PLte7FEGCpudNwNr71-FhUS1g3FAhnNPjD

' Makro kodu: Mesut Akcan
' 18/6/2019
' Güncelleme: 18/7/2019

' www.akcansoft.com
' makcan@gmail.com
' ------------------------------------------------------------
' Daire ya da yaylara VBA ile eksen çizen kodları geliştirme
' Eksen için daire veya yay seçilebilecek
' Farklı nesne seçildiyse çizim yapılmayıp mesaj ile çıkılacak
' Eksen katmanı yoksa eksen katmanı eklenecek
' Katman ayarları yapılacak
' Aktif katman "Eksen" olacak
' "Eksen" katmanına eksen çizgileri çizilecek
' Bir önceki katman aktif katman olacak
' ------------------------------------------------------------
Dim cizgi As AcadLine, nesne As AcadEntity
Dim nkt As Variant, uzunluk As Double
Dim merkezNokta As Variant, n1 As Variant, n2 As Variant
Dim eksenKatman As AcadLayer
Dim aktifKatman As AcadLayer

Utility.GetEntity nesne, nkt, "Eksen çizilecek daire ya da yayı seçiniz: "
If nesne Is Nothing Then
    Utility.Prompt "Herhangi bir nesne seçilmedi!"
    Exit Sub
End If
    
If (TypeOf nesne Is AcadCircle) Or (TypeOf nesne Is AcadArc) Then
    On Error Resume Next ' Hata olursa sonraki satırdan devam eder
    Linetypes.Load "CENTER", "acad.lin"
    On Error GoTo 0
    Set aktifKatman = ActiveLayer

    Set eksenKatman = Layers.Add("Eksen")
    eksenKatman.color = acCyan
    eksenKatman.Linetype = "CENTER"
    ActiveLayer = eksenKatman

    merkezNokta = nesne.Center
    uzunluk = nesne.Radius + 3
    
    n1 = merkezNokta
    n2 = merkezNokta
    
    n1(0) = merkezNokta(0) - uzunluk 'X
    n2(0) = merkezNokta(0) + uzunluk 'X
    
    Set cizgi = ModelSpace.AddLine(n1, n2)
    With cizgi
        .Linetype = "ByLayer"
        .color = acByLayer
        .Lineweight = acLnWtByLayer
    End With
        
    n1 = merkezNokta
    n2 = merkezNokta
    
    n1(1) = merkezNokta(1) - uzunluk 'Y
    n2(1) = merkezNokta(1) + uzunluk 'Y
    
    Set cizgi = ModelSpace.AddLine(n1, n2)
    With cizgi
        .Linetype = "ByLayer"
        .color = acByLayer
        .Lineweight = acLnWtByLayer
    End With
    
    ActiveLayer = aktifKatman
Else
    Utility.Prompt "Seçilen nesne daire ya da yay değil!"
End If
End Sub

Yazının sonraki sayfası: AutoCAD ile VBA makro kullanımı #4-2

İlgili video:


AutoCAD ile VBA Makro kullanımı playlist:
https://www.youtube.com/playlist?list=PLte7FEGCpudNwNr71-FhUS1g3FAhnNPjD

Hiç yorum yok:

Yorum Gönder