18 Haziran 2019 Salı

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


AutoCAD ile VBA Makro kullanımı playlist:
https://www.youtube.com/playlist?list=PLte7FEGCpudNwNr71-FhUS1g3FAhnNPjD
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
' mesutakcan.blogspot.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

Hiç yorum yok:

Yorum Gönder