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