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