Yayınlama: 9/4/2020
Güncelleme: 8/11/2023
Slot(oyuk) çizen VBA makro kodları:
Sub SLOT() ' Slot (oyuk) çizer ' Makro kodu: Mesut Akcan ' 30 Mart 2020 ' mesutakcan.blogspot.com Dim c As AcadLine Dim yay As AcadArc pi = 4 * Atn(1) '3,14159265358979 a90 = pi / 2 'Açı 90 - radyan a270 = pi * 3 / 2 'Açı 270 - radyan With ThisDrawing.Utility n1 = .GetPoint(, "Birinci merkez nokta:") n2 = .GetPoint(n1, "İkinci merkez nokta:") Set c = ThisDrawing.ModelSpace.AddLine(n1, n2) c.color = acGreen c.Highlight True r = .GetDistance(n2, "Yarıçap:") c.Delete a = .AngleFromXAxis(n1, n2) p1 = .PolarPoint(n1, a + a90, r) p2 = .PolarPoint(n2, a + a90, r) Set c = ThisDrawing.ModelSpace.AddLine(p1, p2) p1 = .PolarPoint(n1, a + a270, r) p2 = .PolarPoint(n2, a + a270, r) Set c = ThisDrawing.ModelSpace.AddLine(p1, p2) End With With ThisDrawing.ModelSpace Set yay = .AddArc(n1, r, a + a90, a + a270) Set yay = .AddArc(n2, r, a + a270, a + a90) End With End Sub
Alternatif kod
Sub SLOT2() ' Slot (oyuk) çizer ' Makro kodu: Mesut Akcan ' 08/11/2023 ' mesutakcan.blogspot.com Dim cizgi As AcadLine Dim yay As AcadArc Dim r As Double, a As Double Dim n1 As Variant, n2 As Variant Dim oc1 As Variant, oc2 As Variant Const pi = 3.14159265358979 With ThisDrawing.Utility n1 = .GetPoint(, "Birinci merkez nokta:") n2 = .GetPoint(n1, "İkinci merkez nokta:") 'Geçici çizgi Set cizgi = ThisDrawing.ModelSpace.AddLine(n1, n2) a = cizgi.Angle 'geçici çizgi açısı cizgi.Highlight True 'vurgulu yap r = .GetDistance(n2, "Yarıçap:") 'yay yarıçapı oc1 = cizgi.Offset(r) 'offset çizgi 1 oc2 = cizgi.Offset(-r) 'offset çizgi 2 cizgi.Delete 'geçici çizgiyi sil End With 'çizgi uçlarını yay ile birleştir With ThisDrawing.ModelSpace Set yay = .AddArc(n1, r, a + pi / 2, a - pi / 2) Set yay = .AddArc(n2, r, a - pi / 2, a + pi / 2) End With End Sub
Hiç yorum yok:
Yorum Gönder