8 Kasım 2023 Çarşamba

AutoCAD ile VBA Makro Kullanımı #6-3

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