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